Merge #1626

1626: Initial integration with shelley node r=Anviking a=Anviking # Issue Number ADP-289, #1657 # Overview - [x] Copied the `cardano-wallet-byron` structure and made it compile for shelley - [x] Completely unimplemented `TransactionLayer` - [x] A few integration tests and unit tests are running (that don't need txs) - [x] Add appropriate CLI and API - [x] Make sure a wallet can be restored # Comments   Co-authored-by: Johannes Lund <[email protected]> Co-authored-by: Samuel Leathers <[email protected]> Co-authored-by: IOHK <[email protected]> Co-authored-by: Rodney Lorrimar <[email protected]>
cardano-foundation · May 14, 2020 · f36904e · f36904e
2 parents 63b6582 + 42bd00c
commit f36904e
Show file tree

Hide file tree

Showing 91 changed files with 9,655 additions and 164 deletions.
diff --git a/.buildkite/docker-build-push.nix b/.buildkite/docker-build-push.nix
@@ -44,10 +44,8 @@ with hostPkgs;
 with hostPkgs.lib;
 
 let
-  images = map impureCreated [
-    walletPackages.dockerImage.jormungandr
-    walletPackages.dockerImage.byron
-  ];
+  images = mapAttrsToList (const impureCreated)
+    (filterAttrs (const isDerivation) walletPackages.dockerImage);
 
   # Override Docker image, setting its creation date to the current time rather than the unix epoch.
   impureCreated = image: image.overrideAttrs (oldAttrs: { created = "now"; }) // { inherit (image) version backend; };

diff --git a/default.nix b/default.nix
@@ -9,6 +9,7 @@
 #
 #   - cardano-wallet-jormungandr - cli executable
 #   - cardano-wallet-byron - cli executable
+#   - cardano-wallet-shelley - cli executable
 #   - tests - attrset of test-suite executables
 #     - cardano-wallet-core.unit
 #     - cardano-wallet-jormungandr.jormungandr-integration
@@ -28,6 +29,7 @@
 #   - dockerImage - tarballs of the docker images
 #     - jormungandr
 #     - byron
+#     - shelley
 #   - shell - imported by shell.nix
 #   - haskellPackages - a Haskell.nix package set of all packages and their dependencies
 #     - cardano-wallet-core.components.library
@@ -97,6 +99,13 @@ let
       inherit (self) cardano-node;
     };
 
+    cardano-wallet-shelley = import ./nix/package-cardano-node.nix {
+      inherit pkgs gitrev;
+      haskellBuildUtils = haskellBuildUtils.package;
+      exe = haskellPackages.cardano-wallet-shelley.components.exes.cardano-wallet-shelley;
+      inherit (self) cardano-node;
+    };
+
     # `tests` are the test suites which have been built.
     tests = collectComponents "tests" isCardanoWallet haskellPackages;
     # `checks` are the result of executing the tests.
@@ -111,6 +120,7 @@ let
     in recurseIntoAttrs (mapAttrs mkDockerImage {
       jormungandr = self.cardano-wallet-jormungandr;
       byron = self.cardano-wallet-byron;
+      shelley = self.cardano-wallet-shelley;
     });
 
     shell = haskellPackages.shellFor {
@@ -120,6 +130,7 @@ let
         cardano-wallet-core
         cardano-wallet-core-integration
         cardano-wallet-byron
+        cardano-wallet-shelley
         cardano-wallet-jormungandr
         cardano-wallet-launcher
         cardano-wallet-test-utils

diff --git a/lib/byron/cardano-wallet-byron.cabal b/lib/byron/cardano-wallet-byron.cabal
@@ -182,7 +182,6 @@ test-suite integration
     , command
     , generic-lens
     , hspec
-    , http-api-data
     , http-client
     , http-types
     , iohk-monitoring
@@ -198,10 +197,7 @@ test-suite integration
       Main.hs
   other-modules:
       Cardano.Wallet.Byron.Faucet
-      Test.Integration.Byron.Scenario.API.Addresses
       Test.Integration.Byron.Scenario.API.Transactions
-      Test.Integration.Byron.Scenario.CLI.Addresses
-      Test.Integration.Byron.Scenario.CLI.Wallets
       Test.Integration.Byron.Scenario.CLI.Transactions
 
 benchmark restore

diff --git a/lib/byron/src/Cardano/Wallet/Byron/Launch.hs b/lib/byron/src/Cardano/Wallet/Byron/Launch.hs
@@ -49,7 +49,7 @@ import Cardano.Wallet.Byron.Compatibility
     , testnetVersionData
     )
 import Cardano.Wallet.Byron.Transaction
-    ( fromGenesisTxOut )
+    ( genesisBlockFromTxOuts )
 import Cardano.Wallet.Logging
     ( trMessageText )
 import Cardano.Wallet.Network.Ports
@@ -185,7 +185,7 @@ parseGenesisData = \case
             ( discriminant
             , gbp
             , vData
-            , fromGenesisTxOut (staticParameters gbp) outs
+            , genesisBlockFromTxOuts (staticParameters gbp) outs
             )
 
 --------------------------------------------------------------------------------
@@ -318,7 +318,7 @@ withConfig tdir minSeverity action =
                 , nodeSocketFile
                 , nodeTopologyFile
                 }
-            , fromGenesisTxOut (staticParameters gbp) outs
+            , genesisBlockFromTxOuts (staticParameters gbp) outs
             , ( gbp
               , ( NodeToClientVersionData { networkMagic }
                 , nodeToClientCodecCBORTerm

diff --git a/lib/byron/src/Cardano/Wallet/Byron/Network.hs b/lib/byron/src/Cardano/Wallet/Byron/Network.hs
@@ -7,7 +7,6 @@
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- |
@@ -107,8 +106,6 @@ import Data.Function
     ( (&) )
 import Data.List
     ( isInfixOf )
-import Data.Proxy
-    ( Proxy (..) )
 import Data.Quantity
     ( Quantity (..) )
 import Data.Text
@@ -125,32 +122,23 @@ import Network.Mux
     ( AppType (..), MuxError (..), MuxErrorType (..), WithMuxBearer )
 import Ouroboros.Consensus.Byron.Ledger
     ( ByronBlock (..)
+    , ByronNodeToClientVersion (ByronNodeToClientVersion2)
+    , CodecConfig (..)
     , GenTx
     , Query (..)
-    , decodeByronBlock
-    , decodeByronGenTx
-    , decodeByronHeaderHash
-    , encodeByronBlock
-    , encodeByronGenTx
-    , encodeByronHeaderHash
     )
 import Ouroboros.Consensus.Byron.Node
     ()
-import Ouroboros.Consensus.Node.Run
-    ( RunNode (..) )
+import Ouroboros.Consensus.Network.NodeToClient
+    ( ClientCodecs, Codecs' (..), DefaultCodecs, clientCodecs, defaultCodecs )
 import Ouroboros.Network.Block
     ( Point (..)
     , SlotNo (..)
     , Tip (..)
-    , decodePoint
-    , decodeTip
-    , encodePoint
-    , encodeTip
     , genesisPoint
     , getTipPoint
     , pointHash
     , pointSlot
-    , unwrapCBORinCBOR
     )
 import Ouroboros.Network.Client.Wallet
     ( ChainSyncCmd (..)
@@ -187,20 +175,14 @@ import Ouroboros.Network.Protocol.ChainSync.Client
     ( chainSyncClientPeer )
 import Ouroboros.Network.Protocol.ChainSync.ClientPipelined
     ( chainSyncClientPeerPipelined )
-import Ouroboros.Network.Protocol.ChainSync.Codec
-    ( codecChainSync, codecChainSyncSerialised )
 import Ouroboros.Network.Protocol.Handshake.Version
     ( DictVersion (..), simpleSingletonVersions )
 import Ouroboros.Network.Protocol.LocalStateQuery.Client
     ( localStateQueryClientPeer )
-import Ouroboros.Network.Protocol.LocalStateQuery.Codec
-    ( codecLocalStateQuery )
 import Ouroboros.Network.Protocol.LocalStateQuery.Type
     ( AcquireFailure, LocalStateQuery )
 import Ouroboros.Network.Protocol.LocalTxSubmission.Client
     ( localTxSubmissionClientPeer )
-import Ouroboros.Network.Protocol.LocalTxSubmission.Codec
-    ( codecLocalTxSubmission )
 import Ouroboros.Network.Protocol.LocalTxSubmission.Type
     ( LocalTxSubmission )
 import System.IO.Error
@@ -351,13 +333,7 @@ mkWalletClient bp chainSyncQ =
             let
                 fromTip' =
                     fromTip getGenesisBlockHash getEpochLength
-                codec = codecChainSync
-                    encodeByronBlock
-                    (unwrapCBORinCBOR $ decodeByronBlock (toEpochSlots getEpochLength))
-                    (encodePoint encodeByronHeaderHash)
-                    (decodePoint decodeByronHeaderHash)
-                    (encodeTip encodeByronHeaderHash)
-                    (decodeTip decodeByronHeaderHash)
+                codec = cChainSyncCodec codecs
             in
             InitiatorProtocolOnly $ MuxPeerRaw
                 $ \channel -> runPipelinedPeer nullTracer codec channel
@@ -378,6 +354,12 @@ mkWalletClient bp chainSyncQ =
         , getGenesisBlockHash
         } = bp
 
+    codecs :: MonadST m => ClientCodecs ByronBlock m
+    codecs = clientCodecs
+        (ByronCodecConfig (toEpochSlots getEpochLength))
+        ByronNodeToClientVersion2
+
+
 -- | Construct a network client with the given communication channel, for the
 -- purpose of:
 --
@@ -417,11 +399,6 @@ mkTipSyncClient tr gbp localTxSubmissionQ onTipUpdate onTxParamsUpdate = do
             Right (Right ls) ->
                 onTxParamsUpdate' $ txParametersFromUpdateState ls
 
-        W.BlockchainParameters
-            { getGenesisBlockHash
-            , getEpochLength
-            } = W.staticParameters gbp
-
     onTipUpdate' <- debounce $ \tip -> do
         traceWith tr $ MsgNodeTip $ fromTip getGenesisBlockHash getEpochLength tip
         onTipUpdate tip
@@ -430,11 +407,7 @@ mkTipSyncClient tr gbp localTxSubmissionQ onTipUpdate onTxParamsUpdate = do
     pure $ nodeToClientProtocols NodeToClientProtocols
         { localChainSyncProtocol =
             let
-                codec = codecChainSyncSerialised
-                    (encodePoint encodeByronHeaderHash)
-                    (decodePoint decodeByronHeaderHash)
-                    (encodeTip encodeByronHeaderHash)
-                    (decodeTip decodeByronHeaderHash)
+                codec = cChainSyncCodec codecs
             in
             InitiatorProtocolOnly $ MuxPeerRaw
                 $ \channel -> runPeer nullTracer codec channel
@@ -444,11 +417,7 @@ mkTipSyncClient tr gbp localTxSubmissionQ onTipUpdate onTxParamsUpdate = do
         , localTxSubmissionProtocol =
             let
                 tr' = contramap MsgTxSubmission tr
-                codec = codecLocalTxSubmission
-                    encodeByronGenTx -- Tx -> CBOR.Encoding
-                    decodeByronGenTx -- CBOR.Decoder s Tx
-                    (nodeEncodeApplyTxError (Proxy @ByronBlock))
-                    (nodeDecodeApplyTxError (Proxy @ByronBlock))
+                codec = cTxSubmissionCodec codecs
             in
             InitiatorProtocolOnly $ MuxPeerRaw
                 $ \channel -> runPeer tr' codec channel
@@ -458,20 +427,24 @@ mkTipSyncClient tr gbp localTxSubmissionQ onTipUpdate onTxParamsUpdate = do
         , localStateQueryProtocol =
             let
                 tr' = contramap MsgLocalStateQuery tr
-                codec = codecLocalStateQuery
-                    (encodePoint encodeByronHeaderHash)
-                    (decodePoint decodeByronHeaderHash)
-                    nodeEncodeQuery
-                    nodeDecodeQuery
-                    nodeEncodeResult
-                    nodeDecodeResult
+                codec = cStateQueryCodec codecs
             in
             InitiatorProtocolOnly $ MuxPeerRaw
                 $ \channel -> runPeer tr' codec channel
                 $ localStateQueryClientPeer
                 $ localStateQuery localStateQueryQ
         }
         NodeToClientV_2
+  where
+    W.BlockchainParameters
+        { getGenesisBlockHash
+        , getEpochLength
+        } = W.staticParameters gbp
+
+    codecs :: MonadST m => DefaultCodecs ByronBlock m
+    codecs = defaultCodecs
+        (ByronCodecConfig (toEpochSlots getEpochLength))
+        ByronNodeToClientVersion2
 
 debounce :: (Eq a, MonadSTM m) => (a -> m ()) -> m (a -> m ())
 debounce action = do

diff --git a/lib/byron/src/Cardano/Wallet/Byron/Transaction.hs b/lib/byron/src/Cardano/Wallet/Byron/Transaction.hs
@@ -16,7 +16,7 @@
 
 module Cardano.Wallet.Byron.Transaction
     ( newTransactionLayer
-    , fromGenesisTxOut
+    , genesisBlockFromTxOuts
     ) where
 
 import Prelude
@@ -216,9 +216,12 @@ type instance ErrValidateSelection (IO Byron) = ErrInvalidTxOutAmount
 -- Internal
 --
 
--- | Construct an initial genesis block from a genesis UTxO.
-fromGenesisTxOut :: BlockchainParameters -> [TxOut] -> Block
-fromGenesisTxOut bp outs = Block
+-- | Construct a ("fake") genesis block from genesis transaction outputs.
+--
+-- The genesis data on haskell nodes is not a block at all, unlike the block0 on
+-- jormungandr. This function is a method to deal with the discrepancy.
+genesisBlockFromTxOuts :: BlockchainParameters -> [TxOut] -> Block
+genesisBlockFromTxOuts bp outs = Block
     { delegations  = []
     , header = BlockHeader
         { slotId =

diff --git a/lib/byron/test/integration/Main.hs b/lib/byron/test/integration/Main.hs
@@ -106,14 +106,14 @@ import qualified Cardano.Wallet.Api.Link as Link
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString as BS
 import qualified Data.Text as T
-import qualified Test.Integration.Byron.Scenario.API.Addresses as AddressesByron
 import qualified Test.Integration.Byron.Scenario.API.Transactions as TransactionsByron
-import qualified Test.Integration.Byron.Scenario.CLI.Addresses as AddressesByronCLI
 import qualified Test.Integration.Byron.Scenario.CLI.Transactions as TransactionsByronCLI
-import qualified Test.Integration.Byron.Scenario.CLI.Wallets as WalletsByronCLI
+import qualified Test.Integration.Scenario.API.Byron.Addresses as AddressesByron
 import qualified Test.Integration.Scenario.API.Byron.Transactions as TransactionsByronCommon
 import qualified Test.Integration.Scenario.API.Byron.Wallets as WalletsByron
 import qualified Test.Integration.Scenario.API.Network as Network
+import qualified Test.Integration.Scenario.CLI.Byron.Addresses as AddressesByronCLI
+import qualified Test.Integration.Scenario.CLI.Byron.Wallets as WalletsByronCLI
 import qualified Test.Integration.Scenario.CLI.Keys as KeyCLI
 import qualified Test.Integration.Scenario.CLI.Miscellaneous as MiscellaneousCLI
 import qualified Test.Integration.Scenario.CLI.Mnemonics as MnemonicsCLI

diff --git a/lib/core-integration/cardano-wallet-core-integration.cabal b/lib/core-integration/cardano-wallet-core-integration.cabal
@@ -70,13 +70,16 @@ library
       Test.Integration.Framework.DSL
       Test.Integration.Framework.Request
       Test.Integration.Framework.TestData
-      Test.Integration.Scenario.API.Byron.Transactions
       Test.Integration.Scenario.API.Byron.Wallets
+      Test.Integration.Scenario.API.Byron.Addresses
+      Test.Integration.Scenario.API.Byron.Transactions
       Test.Integration.Scenario.API.Shelley.Addresses
       Test.Integration.Scenario.API.Shelley.HWWallets
       Test.Integration.Scenario.API.Shelley.Transactions
       Test.Integration.Scenario.API.Shelley.Wallets
       Test.Integration.Scenario.API.Network
+      Test.Integration.Scenario.CLI.Byron.Wallets
+      Test.Integration.Scenario.CLI.Byron.Addresses
       Test.Integration.Scenario.CLI.Shelley.Addresses
       Test.Integration.Scenario.CLI.Shelley.HWWallets
       Test.Integration.Scenario.CLI.Shelley.Transactions

diff --git a/...tegration/Byron/Scenario/API/Addresses.hs → ...tegration/Scenario/API/Byron/Addresses.hs b/...tegration/Byron/Scenario/API/Addresses.hs → ...tegration/Scenario/API/Byron/Addresses.hs
@@ -9,7 +9,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Test.Integration.Byron.Scenario.API.Addresses
+module Test.Integration.Scenario.API.Byron.Addresses
     ( spec
     ) where
 

diff --git a/...tegration/Byron/Scenario/CLI/Addresses.hs → ...tegration/Scenario/CLI/Byron/Addresses.hs b/...tegration/Byron/Scenario/CLI/Addresses.hs → ...tegration/Scenario/CLI/Byron/Addresses.hs
@@ -8,7 +8,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Test.Integration.Byron.Scenario.CLI.Addresses
+module Test.Integration.Scenario.CLI.Byron.Addresses
     ( spec
     ) where
 

diff --git a/...Integration/Byron/Scenario/CLI/Wallets.hs → ...Integration/Scenario/CLI/Byron/Wallets.hs b/...Integration/Byron/Scenario/CLI/Wallets.hs → ...Integration/Scenario/CLI/Byron/Wallets.hs
@@ -8,7 +8,7 @@
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Test.Integration.Byron.Scenario.CLI.Wallets
+module Test.Integration.Scenario.CLI.Byron.Wallets
     ( spec
     ) where
 

diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs
@@ -762,14 +762,17 @@ data BlockHeader = BlockHeader
 instance NFData BlockHeader
 
 instance Buildable BlockHeader where
-    build (BlockHeader s (Quantity bh) hh _) =
-        prefixF 8 hhF
-        <> "-["
+    build (BlockHeader s (Quantity bh) hh ph) =
+        prefixF 8 phF
+        <> "<-["
+        <> prefixF 8 hhF
+        <> "-"
         <> build s
         <> "#" <> build (show bh)
         <> "]"
       where
         hhF = build $ T.decodeUtf8 $ convertToBase Base16 $ getHash hh
+        phF = build $ T.decodeUtf8 $ convertToBase Base16 $ getHash ph
 
 {-------------------------------------------------------------------------------
                                       Tx