Merge #1414

1414: cardano-node OBFT - test integration setup  r=KtorZ a=KtorZ

# Issue Number

<!-- Put here a reference to the issue this PR relates to and which requirements it tackles -->

#1346 

# Overview

<!-- Detail in a few bullet points the work accomplished in this PR -->

- 25fe581
  make byron's 'newNetworkLayer' use bracket style allocation
  So that the underlying connection to the node gets cleaned-up when the network layer is destroyed.
Also, make sure to clean up past clients when creating new cursors

- b2b4660
  Retry connecting to client when the socket does not exist
  
- fc51990
  move byron integration scenarios requiring a shelley wallet to Scenario/API/Wallets
  
- 230ac84
  implement 'getCurrentNodeTip' for Byron's network layer
  
- bf65a99
  Move faucets declarations to core-integration for sharing
  
- 455aba4
  add basic integration setup for cardano-node OBFT
  
- 99de24a
  fixup Byron network layer implementation.
  
- b32000c
  remove hard-coded blockchain parameters from integration scenarios
  The parameters are actually different for each network, in particular on Byron where the start_time
changes on every restart

- 2cfee3c
  remove unused dependencies and weeds
  
- cd4f04d
  re-generate nix machinery
  
- a10afb5
  remove unavailable commands from cardano-wallet-byron
  These require non-byron wallets, so it doesn't make sense to have them part of the command-line.

- fcaed2b
  Fix wrong protocol magic for TestNet
  Whoops. Fortunately, we only used MainNet Byron addresses on the ITN 😶

- 4c97098
  require no magic for cardano-node in the integration setup
  We use the 'mainnet' network target which doesn't require any magic inside addresses and such.


# Comments

<!-- Additional comments or screenshots to attach if any -->

```
$ stack test cardano-wallet-byron:integration
.
.
.
.
Finished in 385.0136 seconds
62 examples, 0 failure
```

:warning: There's two scenarios that are _pretty long_ to run in the NETWORK_ group: they need to wait for _the next epoch_, but in OBFT byron, the epoch length is `10*k`. I am not quite sure about setting `k` to values that are _too small_, so I set it to `k=10` at the moment which seems fine (might revisit later) but still leads to an epoch length of 100 slots. 

<!-- 
Don't forget to:

 ✓ Self-review your changes to make sure nothing unexpected slipped through
 ✓ Assign yourself to the PR
 ✓ Assign one or several reviewer(s)
 ✓ Once created, link this PR to its corresponding ticket
 ✓ Assign the PR to a corresponding milestone
 ✓ Acknowledge any changes required to the Wiki
-->


Co-authored-by: KtorZ <matthias.benkort@gmail.com>

.buildkite/rebuild.hs

@@ -163,6 +163,7 @@ buildStep dryRun bk =
             [ color "always"
             , [ "test" ]
             , fast opt
+            , skip "cardano-node-integration"
             , case qaLevel bk of
                 QuickTest -> skip "integration"
                 FullTest -> []

.weeder.yaml

@@ -35,7 +35,6 @@
         - aeson-qq
         - cryptonite
         - exceptions
-        - extra
         - generic-arbitrary
         - lifted-base
         - monad-control
@@ -50,13 +49,13 @@
     - message:
       - name: Module reused between components
       - module:
-        - Cardano.Faucet
+        - Cardano.Wallet.Jormungandr.Faucet
         - Cardano.Wallet.Jormungandr.Launch
         - Test.Integration.Jcli
     - message:
       - name: Weeds exported
       - module:
-        - name: Cardano.Faucet
+        - name: Cardano.Wallet.Jormungandr.Faucet
         - identifier: genFaucets
       - module:
         - name: Cardano.Wallet.Jormungandr.Launch
@@ -125,3 +124,4 @@
     - message:
       - name: Module not compiled
       - module: Cardano.Startup.Windows
+

lib/byron/cardano-wallet-byron.cabal

@@ -44,6 +44,7 @@ library
     , cryptonite
     , deepseq
     , either
+    , exceptions
     , fmt
     , io-sim-classes
     , iohk-monitoring
@@ -52,6 +53,7 @@ library
     , network-mux
     , ouroboros-consensus
     , ouroboros-network
+    , retry
     , serialise
     , text
     , text-class
@@ -98,3 +100,54 @@ executable cardano-wallet-byron
       exe
   main-is:
     cardano-wallet-byron.hs
+
+test-suite cardano-node-integration
+  default-language:
+      Haskell2010
+  default-extensions:
+      NoImplicitPrelude
+      OverloadedStrings
+  ghc-options:
+      -threaded -rtsopts
+      -Wall
+  if (!flag(development))
+    ghc-options:
+      -O2
+      -Werror
+  build-depends:
+      base
+    , aeson
+    , async
+    , bytestring
+    , cardano-crypto-wrapper
+    , cardano-ledger
+    , cardano-wallet-byron
+    , cardano-wallet-cli
+    , cardano-wallet-core
+    , cardano-wallet-core-integration
+    , cardano-wallet-launcher
+    , cardano-wallet-test-utils
+    , directory
+    , filepath
+    , hspec
+    , http-client
+    , iohk-monitoring
+    , network
+    , ouroboros-network
+    , process
+    , temporary
+    , text
+    , time
+    , unordered-containers
+    , yaml
+  build-tools:
+      cardano-wallet-byron
+  type:
+     exitcode-stdio-1.0
+  hs-source-dirs:
+      test/integration
+  main-is:
+      Main.hs
+  other-modules:
+      Cardano.Wallet.Byron.Faucet
+      Cardano.Wallet.Byron.Config

lib/byron/exe/cardano-wallet-byron.hs

@@ -31,13 +31,10 @@ import Cardano.BM.Trace
 import Cardano.CLI
     ( LoggingOptions (..)
     , cli
-    , cmdAddress
     , cmdKey
     , cmdMnemonic
     , cmdNetwork
-    , cmdTransaction
     , cmdVersion
-    , cmdWallet
     , databaseOption
     , enableWindowsANSI
     , helperTracing
@@ -124,12 +121,9 @@ main = withUtf8Encoding $ do
     runCli $ cli $ mempty
         <> cmdServe
         <> cmdMnemonic
-        <> cmdWallet @'Mainnet
-        <> cmdTransaction @'Mainnet
-        <> cmdAddress @'Mainnet
+        <> cmdKey
         <> cmdNetwork @'Mainnet
         <> cmdVersion
-        <> cmdKey
 
 beforeMainLoop
     :: Trace IO MainLog

lib/byron/src/Cardano/Wallet/Byron.hs

@@ -63,7 +63,7 @@ import Cardano.Wallet.Api.Types
 import Cardano.Wallet.Byron.Compatibility
     ( Byron, ByronBlock, fromByronBlock )
 import Cardano.Wallet.Byron.Network
-    ( AddrInfo, newNetworkLayer )
+    ( AddrInfo, withNetworkLayer )
 import Cardano.Wallet.Byron.Transaction
     ( newTransactionLayer )
 import Cardano.Wallet.Byron.Transaction.Size
@@ -198,11 +198,11 @@ serveWallet
         Right (_, socket) -> serveApp socket
   where
     serveApp socket = do
-        nl <- newNetworkLayer nullTracer bp addrInfo versionData
-        byronApi   <- apiLayer (newTransactionLayer @n) nl
-        icarusApi  <- apiLayer (newTransactionLayer @n) nl
-        withNtpClient ntpClientTracer ntpSettings $ \ntpClient -> do
-            startServer socket byronApi icarusApi ntpClient $> ExitSuccess
+        withNetworkLayer nullTracer bp addrInfo versionData $ \nl -> do
+            withNtpClient ntpClientTracer ntpSettings $ \ntpClient -> do
+                byronApi   <- apiLayer (newTransactionLayer @n) nl
+                icarusApi  <- apiLayer (newTransactionLayer @n) nl
+                startServer socket byronApi icarusApi ntpClient $> ExitSuccess
 
     startServer
         :: Socket

lib/byron/src/Cardano/Wallet/Byron/Compatibility.hs

@@ -192,7 +192,9 @@ genesisTip = Tip genesisPoint genesisBlockNo
 mainnetVersionData
     :: NodeVersionData
 mainnetVersionData =
-    ( NodeToClientVersionData { networkMagic = NetworkMagic 764824073 }
+    ( NodeToClientVersionData
+        { networkMagic = NetworkMagic $ fromIntegral $ W.getProtocolMagic W.mainnetMagic
+        }
     , nodeToClientCodecCBORTerm
     )
 

lib/byron/src/Cardano/Wallet/Byron/Network.hs

@@ -21,7 +21,7 @@
 module Cardano.Wallet.Byron.Network
     ( -- * Top-Level Interface
       pattern Cursor
-    , newNetworkLayer
+    , withNetworkLayer
 
       -- * Transport Helpers
     , AddrInfo
@@ -38,6 +38,7 @@ import Cardano.Wallet.Logging
     ( trMessage )
 import Cardano.Wallet.Network
     ( Cursor
+    , ErrCurrentNodeTip (..)
     , ErrGetBlock (..)
     , ErrNetworkUnavailable (..)
     , ErrPostTx (..)
@@ -49,10 +50,14 @@ import Codec.SerialiseTerm
     ( CodecCBORTerm )
 import Control.Concurrent.Async
     ( async, link )
+import Control.Concurrent.MVar
+    ( newEmptyMVar, tryPutMVar, tryReadMVar )
 import Control.Exception
-    ( catch, throwIO )
+    ( IOException )
 import Control.Monad
     ( void )
+import Control.Monad.Catch
+    ( Handler (..) )
 import Control.Monad.Class.MonadAsync
     ( MonadAsync (race) )
 import Control.Monad.Class.MonadST
@@ -73,15 +78,19 @@ import Control.Monad.Class.MonadThrow
 import Control.Monad.Class.MonadTimer
     ( MonadTimer, threadDelay )
 import Control.Monad.IO.Class
-    ( MonadIO )
+    ( MonadIO, liftIO )
 import Control.Monad.Trans.Except
     ( ExceptT (..), throwE, withExceptT )
+import Control.Retry
+    ( RetryPolicyM, fibonacciBackoff, recovering )
 import Control.Tracer
     ( Tracer, contramap )
 import Data.ByteString.Lazy
     ( ByteString )
 import Data.Functor
     ( (<&>) )
+import Data.List
+    ( isInfixOf )
 import Data.Quantity
     ( Quantity (..) )
 import Data.Text
@@ -91,7 +100,7 @@ import Data.Void
 import GHC.Stack
     ( HasCallStack )
 import Network.Mux
-    ( AppType (..), MuxError )
+    ( AppType (..) )
 import Network.Socket
     ( AddrInfo (..), Family (..), SockAddr (..), SocketType (..) )
 import Network.TypedProtocol.Channel
@@ -171,7 +180,7 @@ data instance Cursor (m Byron) = Cursor
     (TQueue m (ChainSyncCmd m))
 
 -- | Create an instance of the network layer
-newNetworkLayer
+withNetworkLayer
     :: Trace IO Text
         -- ^ Logging of network layer startup
     -> W.BlockchainParameters
@@ -180,31 +189,36 @@ newNetworkLayer
         -- ^ Socket for communicating with the node
     -> (NodeToClientVersionData, CodecCBORTerm Text NodeToClientVersionData)
         -- ^ Codecs for the node's client
-    -> IO (NetworkLayer IO (IO Byron) ByronBlock)
-newNetworkLayer tr bp addrInfo versionData = do
+    -> (NetworkLayer IO (IO Byron) ByronBlock -> IO a)
+        -- ^ Callback function with the network layer
+    -> IO a
+withNetworkLayer tr bp addrInfo versionData action = do
     localTxSubmissionQ <- atomically newTQueue
-    pure NetworkLayer
-        { currentNodeTip = _currentNodeTip
-        , nextBlocks = _nextBlocks
-        , initCursor = _initCursor localTxSubmissionQ
-        , cursorSlotId = _cursorSlotId
-        , postTx = _postTx localTxSubmissionQ
-        , stakeDistribution = _stakeDistribution
-        , getAccountBalance = _getAccountBalance
-        }
+    nodeTip <- newEmptyMVar
+    action
+        NetworkLayer
+            { currentNodeTip = _currentNodeTip nodeTip
+            , nextBlocks = _nextBlocks
+            , initCursor = _initCursor nodeTip localTxSubmissionQ
+            , cursorSlotId = _cursorSlotId
+            , postTx = _postTx localTxSubmissionQ
+            , stakeDistribution = _stakeDistribution
+            , getAccountBalance = _getAccountBalance
+            }
   where
     W.BlockchainParameters
-        { getEpochLength
+        { getGenesisBlockHash
+        , getEpochLength
         } = bp
 
-    _initCursor localTxSubmissionQ headers = do
+    _initCursor nodeTip localTxSubmissionQ headers = do
         chainSyncQ <- atomically newTQueue
         let client = mkNetworkClient tr bp chainSyncQ localTxSubmissionQ
         link =<< async (connectClient client versionData addrInfo)
-
+        void $ tryPutMVar nodeTip chainSyncQ
         let points = genesisPoint : (toPoint getEpochLength <$> headers)
         chainSyncQ `send` CmdFindIntersection points >>= \case
-            Right(Just intersection) ->
+            Right (Just intersection) ->
                 pure $ Cursor intersection chainSyncQ
             _ -> fail
                 "initCursor: intersection not found? This can't happen \
@@ -221,8 +235,16 @@ newNetworkLayer tr bp addrInfo versionData = do
     _getAccountBalance _ =
         pure (Quantity 0)
 
-    _currentNodeTip =
-        notImplemented "currentNodeTip"
+    _currentNodeTip nodeTip =
+        liftIO (tryReadMVar nodeTip) >>= \case
+            Nothing -> throwE $ ErrCurrentNodeTipNetworkUnreachable $
+                ErrNetworkUnreachable "client not yet started."
+            Just chainSyncQ ->
+                liftIO (chainSyncQ `send` CmdCurrentNodeTip) >>= \case
+                    Left e ->
+                        throwE $ ErrCurrentNodeTipNetworkUnreachable e
+                    Right tip ->
+                        pure $ fromTip getGenesisBlockHash getEpochLength tip
 
     _postTx localTxSubmissionQ tx = do
         result <- withExceptT ErrPostTxNetworkUnreachable $
@@ -366,15 +388,19 @@ connectClient client (vData, vCodec) addr = do
     let vDict = DictVersion vCodec
     let versions = simpleSingletonVersions NodeToClientV_1 vData vDict client
     let tracers = NetworkConnectTracers nullTracer nullTracer
-    connectTo tracers versions Nothing addr `catch` handleMuxError
+    recovering policy [const $ Handler handleIOException] $ const $
+        connectTo tracers versions Nothing addr
   where
-    -- `connectTo` might rise an exception: we are the client and the protocols
-    -- specify that only  client can lawfuly close a connection, but the other
-    -- side might just disappear.
-    --
-    -- NOTE: This handler does nothing.
-    handleMuxError :: MuxError -> IO ()
-    handleMuxError = throwIO
+    -- .5s → .5s → 1s → 1.5s → 2.5s → 4s → 6.5s → 10.5s → 17s → 27.5s ...
+    policy :: RetryPolicyM IO
+    policy = fibonacciBackoff 500
+
+    -- There's a race-condition when starting the wallet and the node at the
+    -- same time: the socket might not be there yet when we try to open it.
+    -- In such case, we simply retry a bit later and hope it's there.
+    handleIOException :: IOException -> IO Bool
+    handleIOException e = pure $
+        "does not exist" `isInfixOf` show e
 
 -- | Client for the 'Chain Sync' mini-protocol.
 --