Cardano.Api -> Cardano.Api.Typed and HardForkBlock

cardano-1.15.x.yaml → cardano-1.17.x.yaml

@@ -1,4 +1,4 @@
-name: cardano-1.15.x
+name: cardano-1.17.x
 
 resolver: lts-14.25
 
@@ -54,7 +54,7 @@ packages:
 - word-wrap-0.4.1
 
 - git: https://github.com/input-output-hk/cardano-base
-  commit: 5e0b8bc8c7862be12da6989440f8644ba7c1e1cf
+  commit: 7d795c3040ea7785812efa1c97864bbb41b15d3e
   subdirs:
   - binary
   - binary/test
@@ -66,7 +66,7 @@ packages:
   commit: 2547ad1e80aeabca2899951601079408becbc92c
 
 - git: https://github.com/input-output-hk/cardano-ledger-specs
-  commit: 12b13f390d64df6af6054b0d33bb3767756da041
+  commit: a790fb38cced04d8d8a9aeacc2a761717f11f94e
   subdirs:
   - byron/ledger/impl
   - byron/crypto
@@ -75,12 +75,13 @@ packages:
   - byron/chain/executable-spec
   - byron/ledger/executable-spec
   - semantics/executable-spec
+  - semantics/small-steps-test
   - shelley/chain-and-ledger/dependencies/non-integer
   - shelley/chain-and-ledger/executable-spec
   - shelley/chain-and-ledger/executable-spec/test
 
 - git: https://github.com/input-output-hk/cardano-node
-  commit: 97b3e95c67940608f5acda929cf861e8ebfeddd1
+  commit: 0191ff56d194b6ac074af0d51e67493c14e08ffa
   subdirs:
   - cardano-api
   - cardano-cli
@@ -93,11 +94,6 @@ packages:
   - .
   - test
 
-- git: https://github.com/input-output-hk/cardano-shell
-  commit: 5257fc818ef7df60986834310432e197aac90711
-  subdirs:
-  - cardano-shell
-
 - git: https://github.com/input-output-hk/cardano-sl-x509
   commit: 43a036c5bbe68ca2e9cbe611eab7982e2348fe49
 
@@ -117,7 +113,7 @@ packages:
   - plugins/backend-trace-forwarder
 
 - git: https://github.com/input-output-hk/ouroboros-network
-  commit: 1361bb92814c65e5964732777fc7f8ec9ebdccfe
+  commit: 34e380f54ed24772479763ba6d67f4893d82aac2
   subdirs:
   - io-sim
   - io-sim-classes

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

@@ -272,8 +272,8 @@ server byron icarus ntp =
     byronMigrations :: Server (ByronMigrations n)
     byronMigrations =
              (\wid -> withLegacyLayer wid
-                (byron , getMigrationInfo byron wid)
-                (icarus, getMigrationInfo icarus wid)
+                (byron , getMigrationInfo @_ @_ @_ @n byron wid)
+                (icarus, getMigrationInfo @_ @_ @_ @n icarus wid)
              )
         :<|> (\wid m -> withLegacyLayer wid
                 (byron , migrateWallet byron wid m)

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

@@ -114,7 +114,7 @@ import Network.Mux
     ( MuxError (..), MuxErrorType (..), WithMuxBearer )
 import Ouroboros.Consensus.Byron.Ledger
     ( ByronBlock (..)
-    , ByronNodeToClientVersion (ByronNodeToClientVersion2)
+    , ByronNodeToClientVersion (ByronNodeToClientVersion1)
     , GenTx
     , Query (..)
     )
@@ -354,7 +354,7 @@ mkWalletClient gp chainSyncQ = do
         } = gp
 
     codecs :: MonadST m => ClientCodecs ByronBlock m
-    codecs = clientCodecs (byronCodecConfig gp) ByronNodeToClientVersion2
+    codecs = clientCodecs (byronCodecConfig gp) ByronNodeToClientVersion1
 
     -- A low-level DEBUG chain sync tracer.
     --
@@ -444,7 +444,7 @@ mkTipSyncClient tr np localTxSubmissionQ onTipUpdate onProtocolParamsUpdate = do
         } = W.genesisParameters np
 
     codecs :: MonadST m => DefaultCodecs ByronBlock m
-    codecs = defaultCodecs (byronCodecConfig gp) ByronNodeToClientVersion2
+    codecs = defaultCodecs (byronCodecConfig gp) ByronNodeToClientVersion1
 
 debounce :: (Eq a, MonadSTM m) => (a -> m ()) -> m (a -> m ())
 debounce action = do

lib/core-integration/src/Test/Integration/Faucet.hs

@@ -3,6 +3,7 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -16,11 +17,15 @@ module Test.Integration.Faucet
     , icaMnemonics
     , rndMnemonics
 
+      -- * Integration test funds
+    , shelleyIntegrationTestFunds
+
       -- * Internals
     , genByronFaucets
     , genIcarusFaucets
     , genShelleyFaucets
     , genMnemonics
+    , genShelleyAddresses
     ) where
 
 import Prelude hiding
@@ -48,9 +53,9 @@ import Cardano.Wallet.Primitive.AddressDerivation
     , liftIndex
     )
 import Cardano.Wallet.Primitive.Types
-    ( Address (..), Coin )
+    ( Address (..), Coin (..) )
 import Cardano.Wallet.Unsafe
-    ( unsafeMkMnemonic )
+    ( unsafeFromHex, unsafeMkMnemonic )
 import Control.Concurrent.MVar
     ( MVar, putMVar, takeMVar )
 import Control.Monad
@@ -1388,38 +1393,31 @@ genIcarusFaucets = genFaucet encodeAddress genAddresses
 --
 -- >>> genMnemonics 100 >>= genShelleyFaucets "shelley-faucets.yaml"
 genShelleyFaucets :: FilePath -> [Mnemonic 15] -> IO ()
-genShelleyFaucets = genFaucet encodeAddress genAddresses
+genShelleyFaucets = genFaucet encodeAddress genShelleyAddresses
   where
     encodeAddress :: Address -> Text
     encodeAddress (Address bytes) =
         T.decodeUtf8 $ convertToBase Base16 bytes
 
-    genAddresses :: Mnemonic 15 -> [Address]
-    genAddresses mw =
-        let
-            (seed, pwd) =
-                (SomeMnemonic mw, mempty)
-            rootXPrv =
-                Shelley.generateKeyFromSeed (seed, Nothing) pwd
-            accXPrv =
-                deriveAccountPrivateKey pwd rootXPrv minBound
-            addrXPrv =
-                deriveAddressPrivateKey pwd accXPrv UTxOExternal
-        in
-            [ paymentAddress @'Mainnet $ publicKey $ addrXPrv ix
-            | ix <- [minBound..maxBound]
-            ]
+genShelleyAddresses :: Mnemonic 15 -> [Address]
+genShelleyAddresses mw =
+    let
+        (seed, pwd) =
+            (SomeMnemonic mw, mempty)
+        rootXPrv =
+            Shelley.generateKeyFromSeed (seed, Nothing) pwd
+        accXPrv =
+            deriveAccountPrivateKey pwd rootXPrv minBound
+        addrXPrv =
+            deriveAddressPrivateKey pwd accXPrv UTxOExternal
+    in
+        [ paymentAddress @'Mainnet $ publicKey $ addrXPrv ix
+        | ix <- [minBound..maxBound]
+        ]
 
 -- | Abstract function for generating a faucet.
 genFaucet
-    :: forall mw ent csz.
-        ( ValidMnemonicSentence mw
-        , ValidEntropySize ent
-        , ValidChecksumSize ent csz
-        , ent ~ EntropySize mw
-        , mw ~ MnemonicWords ent
-        )
-    => (Address -> Text)
+    :: (Address -> Text)
     -> (Mnemonic mw -> [Address])
     -> FilePath
     -> [Mnemonic mw]
@@ -1451,6 +1449,55 @@ genMnemonics
 genMnemonics n =
     replicateM n (entropyToMnemonic @mw <$> genEntropy)
 
+--
+-- Integration test funds
+--
+
+-- | A special wallet with only dust
+onlyDustWallet :: Mnemonic 15
+onlyDustWallet = unsafeMkMnemonic
+    [ "either" , "flip" , "maple" , "shift" , "dismiss"
+    , "bridge" , "sweet" , "reveal" , "green" , "tornado"
+    , "need" , "patient" , "wall" , "stamp" , "pass"
+    ]
+
+-- | A special Shelley Wallet with 200 UTxOs where 100 of them are dust
+bigDustWallet :: Mnemonic 15
+bigDustWallet = unsafeMkMnemonic
+    [ "radar", "scare", "sense", "winner", "little"
+    , "jeans", "blue", "spell", "mystery", "sketch"
+    , "omit", "time", "tiger", "leave", "load"
+    ]
+
+shelleyIntegrationTestFunds :: [(Address, Coin)]
+shelleyIntegrationTestFunds = mconcat
+    [ seqMnemonics >>= (take 10 . map (, defaultAmt) . addresses)
+
+    , zip (addresses onlyDustWallet) (map Coin [1,1,5,12,1,5,3,10,2,3])
+
+    , take 100 (map (, defaultAmt) $ addresses bigDustWallet)
+    , take 100 . drop 100 $ map (,Coin 1) $ addresses bigDustWallet
+
+    , preregKeyWalletFunds
+    ]
+  where
+    defaultAmt = Coin 100000000000
+    addresses = genShelleyAddresses
+
+    -- Funds for wallet with a pre-registered stake key.
+    --
+    --  _preregKeyWallet :: Mnemonic 15
+    --  _preregKeyWallet = unsafeMkMnemonic
+    --      ["over", "decorate", "flock", "badge", "beauty"
+    --      , "stamp", "chest", "owner", "excess", "omit"
+    --      , "bid", "raccoon", "spin", "reduce", "rival"
+    --      ]
+    --
+    preregKeyWalletFunds = map ((,defaultAmt) . Address . unsafeFromHex)
+        [ "6199a7c32aaa55a628d936b539f01d5415318dec8bcb5e59ec71af695b"
+        , "61386c7a86d8844f4085a50241556043c9842d72c315c897a42a8a0510"
+        ]
+
 --
 -- Helpers
 --

lib/core-integration/src/Test/Integration/Framework/DSL.hs

@@ -615,12 +615,19 @@ eventuallyUsingDelay
     -> IO a
 eventuallyUsingDelay delay desc io = do
     lastErrorRef <- newIORef Nothing
-    winner <- race (threadDelay $ 300 * oneSecond) (trial lastErrorRef)
+    -- NOTE
+    -- This __90s__ is mostly justified by the parameters in the shelley
+    -- genesis. The longest action we have two wait for are about 2 epochs,
+    -- which corresponds to 80s with the current parameters. Using something
+    -- much longer than that isn't really useful (in particular, this doesn't
+    -- depend on the host machine running the test, because the protocol moves
+    -- forward at the same speed regardless...)
+    winner <- race (threadDelay $ 90 * oneSecond) (trial lastErrorRef)
     case winner of
         Left () -> do
             lastError <- readIORef lastErrorRef
             fail $ mconcat
-                [ "Waited longer than 5 minutes for action to resolve. "
+                [ "Waited longer than 2 minutes for an action to resolve. "
                 , "Action: "
                 , show desc
                 , ". Error condition: "
@@ -671,25 +678,25 @@ emptyRandomWallet :: Context t -> IO ApiByronWallet
 emptyRandomWallet ctx = do
     mnemonic <- mnemonicToText @12 . entropyToMnemonic <$> genEntropy
     emptyByronWalletWith ctx "random"
-        ("Random Wallet", mnemonic, "Secure Passphrase")
+        ("Random Wallet", mnemonic, fixturePassphrase)
 
 emptyRandomWalletMws :: Context t -> IO (ApiByronWallet, Mnemonic 12)
 emptyRandomWalletMws ctx = do
     mnemonic <- entropyToMnemonic <$> genEntropy
     (,mnemonic) <$> emptyByronWalletWith ctx "random"
-        ("Random Wallet", mnemonicToText @12 mnemonic, "Secure Passphrase")
+        ("Random Wallet", mnemonicToText @12 mnemonic, fixturePassphrase)
 
 emptyIcarusWallet :: Context t -> IO ApiByronWallet
 emptyIcarusWallet ctx = do
     mnemonic <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy
     emptyByronWalletWith ctx "icarus"
-        ("Icarus Wallet", mnemonic, "Secure Passphrase")
+        ("Icarus Wallet", mnemonic, fixturePassphrase)
 
 emptyIcarusWalletMws :: Context t -> IO (ApiByronWallet, Mnemonic 15)
 emptyIcarusWalletMws ctx = do
     mnemonic <- entropyToMnemonic <$> genEntropy
     (,mnemonic) <$> emptyByronWalletWith ctx "icarus"
-        ("Icarus Wallet",mnemonicToText @15 mnemonic, "Secure Passphrase")
+        ("Icarus Wallet",mnemonicToText @15 mnemonic, fixturePassphrase)
 
 emptyRandomWalletWithPasswd :: Context t -> Text -> IO ApiByronWallet
 emptyRandomWalletWithPasswd ctx rawPwd = do
@@ -756,7 +763,7 @@ emptyWallet ctx = do
     let payload = Json [aesonQQ| {
             "name": "Empty Wallet",
             "mnemonic_sentence": #{mnemonic},
-            "passphrase": "Secure Passphrase"
+            "passphrase": #{fixturePassphrase}
         }|]
     r <- request @ApiWallet ctx
         (Link.postWallet @'Shelley) Default payload

lib/core-integration/src/Test/Integration/Framework/TestData.hs

@@ -86,7 +86,7 @@ import Data.Text
 import Numeric.Natural
     ( Natural )
 import Test.Integration.Framework.DSL
-    ( Payload (..), json )
+    ( Payload (..), fixturePassphrase, json )
 
 falseWalletIds :: [(String, String)]
 falseWalletIds =
@@ -216,14 +216,14 @@ payloadWith :: Text -> [Text] -> Payload
 payloadWith name mnemonics = Json [json| {
      "name": #{name},
      "mnemonic_sentence": #{mnemonics},
-     "passphrase": "Secure passphrase"
+     "passphrase": #{fixturePassphrase}
      } |]
 
 simplePayload :: Payload
 simplePayload = Json [json| {
     "name": "Secure Wallet",
     "mnemonic_sentence": #{mnemonics21},
-    "passphrase": "Secure passphrase"
+    "passphrase": #{fixturePassphrase}
     } |]
 
 updateNamePayload :: Text -> Payload
@@ -287,12 +287,16 @@ errMsg403NotEnoughMoney_ =
     "I can't process this payment because there's not enough UTxO available in \
     \the wallet."
 
-errMsg403NotEnoughMoney :: Int -> Int -> String
+errMsg403NotEnoughMoney :: Integral i => i -> i -> String
 errMsg403NotEnoughMoney has needs = "I can't process this payment because there's\
     \ not enough UTxO available in the wallet. The total UTxO sums up to\
-    \ " ++ show has ++ " Lovelace, but I need " ++ show needs ++ " Lovelace\
+    \ " ++ has' ++ " Lovelace, but I need " ++ needs' ++ " Lovelace\
     \ (excluding fee amount) in order to proceed  with the payment."
 
+  where
+    needs' = show (toInteger needs)
+    has' = show (toInteger has)
+
 errMsg403TxTooBig :: Int -> String
 errMsg403TxTooBig n = "I had to select " ++ show n ++ " inputs to construct the\
     \ requested transaction. Unfortunately, this would create a transaction\