diff --git a/lib/core-integration/cardano-wallet-core-integration.cabal b/lib/core-integration/cardano-wallet-core-integration.cabal index beb156bdaa1..eb5e969b594 100644 --- a/lib/core-integration/cardano-wallet-core-integration.cabal +++ b/lib/core-integration/cardano-wallet-core-integration.cabal @@ -64,6 +64,7 @@ library , memory , optparse-applicative , process + , resourcet , retry , say , scrypt diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 3a99d295e56..6cff99e199c 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -22,6 +22,7 @@ module Test.Integration.Framework.DSL -- * Steps , request , unsafeRequest + , unsafeResponse -- * Expectations , expectPathEventuallyExist @@ -49,9 +50,7 @@ module Test.Integration.Framework.DSL -- * Lens , walletId - -- * Helpers - , () - , (!!) + -- * Create wallets , restoreWalletFromPubKey , emptyRandomWallet , emptyRandomWalletMws @@ -59,10 +58,17 @@ module Test.Integration.Framework.DSL , emptyIcarusWallet , emptyIcarusWalletMws , emptyByronWalletWith + , postWallet + , postWallet' + , postByronWallet , emptyWallet , emptyWalletWith , emptyByronWalletFromXPrvWith , rewardWallet + + -- * Helpers + , () + , (!!) , genMnemonics , genMnemonics' , getFromResponse @@ -140,6 +146,10 @@ module Test.Integration.Framework.DSL , postExternalTransactionViaCLI , deleteTransactionViaCLI , getTransactionViaCLI + + -- * Re-exports + , runResourceT + , ResourceT ) where import Cardano.CLI @@ -232,13 +242,17 @@ import Control.Concurrent import Control.Concurrent.Async ( async, race, wait ) import Control.Exception - ( SomeException (..), catch ) + ( SomeException (..) ) import Control.Monad ( forM_, join, unless, void ) +import Control.Monad.Catch + ( MonadCatch, catch ) import Control.Monad.Fail ( MonadFail (..) ) import Control.Monad.IO.Class ( MonadIO, liftIO ) +import Control.Monad.Trans.Resource + ( ResourceT, allocate, runResourceT ) import Control.Retry ( capDelay, constantDelay, retrying ) import Crypto.Hash @@ -538,16 +552,17 @@ genMnemonics M21 = genMnemonics' @21 genMnemonics M24 = genMnemonics' @24 genMnemonics' - :: forall mw ent csz. + :: forall mw ent csz m. ( ConsistentEntropy ent mw csz , ValidEntropySize ent , ValidChecksumSize ent csz , ent ~ EntropySize mw , mw ~ MnemonicWords ent + , MonadIO m ) - => IO [Text] + => m [Text] genMnemonics' = - mnemonicToText . entropyToMnemonic @mw <$> genEntropy + liftIO $ mnemonicToText . entropyToMnemonic @mw <$> genEntropy getTxId :: (ApiTransaction n) -> String getTxId tx = T.unpack $ toUrlPiece $ ApiTxId (tx ^. #id) @@ -561,18 +576,24 @@ unsafeGetTransactionTime txs = _ -> error "Expected at least one transaction with a time." waitAllTxsInLedger - :: forall n t. (DecodeAddress n, DecodeStakeAddress n) + :: forall n t m. + ( DecodeAddress n + , DecodeStakeAddress n + , MonadIO m + , MonadCatch m + ) => Context t -> ApiWallet - -> IO () + -> m () waitAllTxsInLedger ctx w = eventually "waitAllTxsInLedger: all txs in ledger" $ do let ep = Link.listTransactions @'Shelley w (_, txs) <- unsafeRequest @[ApiTransaction n] ctx ep Empty view (#status . #getApiT) <$> txs `shouldSatisfy` all (== InLedger) waitForNextEpoch - :: Context t - -> IO () + :: (MonadIO m, MonadCatch m, MonadFail m) + => Context t + -> m () waitForNextEpoch ctx = do epoch <- getFromResponse (#nodeTip . #epochNumber) <$> request @ApiNetworkInformation ctx Link.getNetworkInfo Default Empty @@ -647,7 +668,7 @@ a .<= b -- -- It is like 'eventuallyUsingDelay', but with the default delay of 500 ms -- between retries. -eventually :: String -> IO a -> IO a +eventually :: MonadIO m => String -> IO a -> m a eventually = eventuallyUsingDelay (500 * ms) where ms = 1000 @@ -657,11 +678,12 @@ eventually = eventuallyUsingDelay (500 * ms) -- -- It sleeps for a specified delay between retries. eventuallyUsingDelay - :: Int -- ^ Delay in microseconds + :: MonadIO m + => Int -- ^ Delay in microseconds -> String -- ^ Brief description of the IO action -> IO a - -> IO a -eventuallyUsingDelay delay desc io = do + -> m a +eventuallyUsingDelay delay desc io = liftIO $ do lastErrorRef <- newIORef Nothing -- NOTE -- This __90s__ is mostly justified by the parameters in the shelley @@ -696,68 +718,90 @@ utcIso8601ToText = utcTimeToText iso8601ExtendedUtc -- | Restore HW Wallet from pub key restoreWalletFromPubKey - :: forall w (style :: WalletStyle) t. + :: forall w (style :: WalletStyle) t m. ( Link.Discriminate style , Link.PostWallet style , HasType (ApiT WalletId) w , HasType (ApiT SyncProgress) w , Show w , FromJSON w + , MonadIO m + , MonadCatch m ) => Context t -> Text -> Text - -> IO w -restoreWalletFromPubKey ctx pubKey name = do - let payloadRestore = Json [aesonQQ| { - "name": #{name}, - "account_public_key": #{pubKey} - }|] - r <- request @w ctx (Link.postWallet @style) Default payloadRestore - expectResponseCode @IO HTTP.status201 r - let wid = getFromResponse id r - eventually "restoreWalletFromPubKey: wallet is 100% synced " $ do - rg <- request @w ctx (Link.getWallet @style wid) Default Empty - expectField (typed @(ApiT SyncProgress) . #getApiT) (`shouldBe` Ready) rg - return wid + -> ResourceT m w +restoreWalletFromPubKey ctx pubKey name = snd <$> allocate create destroy + where + create = do + let payloadRestore = Json [aesonQQ| { + "name": #{name}, + "account_public_key": #{pubKey} + }|] + r <- request @w ctx (Link.postWallet @style) Default payloadRestore + expectResponseCode HTTP.status201 r + let wid = getFromResponse id r + eventually "restoreWalletFromPubKey: wallet is 100% synced " $ do + rg <- request @w ctx (Link.getWallet @style wid) Default Empty + expectField (typed @(ApiT SyncProgress) . #getApiT) (`shouldBe` Ready) rg + return wid + destroy w = void $ request @Aeson.Value ctx + (Link.deleteWallet @style w) Default Empty -- | Create an empty wallet -emptyRandomWallet :: Context t -> IO ApiByronWallet +emptyRandomWallet + :: (MonadIO m, MonadCatch m) + => Context t + -> ResourceT m ApiByronWallet emptyRandomWallet ctx = do - mnemonic <- mnemonicToText @12 . entropyToMnemonic <$> genEntropy + mnemonic <- liftIO $ mnemonicToText @12 . entropyToMnemonic <$> genEntropy emptyByronWalletWith ctx "random" ("Random Wallet", mnemonic, fixturePassphrase) -emptyRandomWalletMws :: Context t -> IO (ApiByronWallet, Mnemonic 12) +emptyRandomWalletMws + :: (MonadIO m, MonadCatch m) + => Context t + -> ResourceT m (ApiByronWallet, Mnemonic 12) emptyRandomWalletMws ctx = do - mnemonic <- entropyToMnemonic <$> genEntropy + mnemonic <- liftIO $ entropyToMnemonic <$> genEntropy (,mnemonic) <$> emptyByronWalletWith ctx "random" ("Random Wallet", mnemonicToText @12 mnemonic, fixturePassphrase) -emptyIcarusWallet :: Context t -> IO ApiByronWallet +emptyIcarusWallet + :: (MonadIO m, MonadCatch m) + => Context t + -> ResourceT m ApiByronWallet emptyIcarusWallet ctx = do - mnemonic <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + mnemonic <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy emptyByronWalletWith ctx "icarus" ("Icarus Wallet", mnemonic, fixturePassphrase) -emptyIcarusWalletMws :: Context t -> IO (ApiByronWallet, Mnemonic 15) +emptyIcarusWalletMws + :: (MonadIO m, MonadCatch m) + => Context t + -> ResourceT m (ApiByronWallet, Mnemonic 15) emptyIcarusWalletMws ctx = do - mnemonic <- entropyToMnemonic <$> genEntropy + mnemonic <- liftIO $ entropyToMnemonic <$> genEntropy (,mnemonic) <$> emptyByronWalletWith ctx "icarus" ("Icarus Wallet",mnemonicToText @15 mnemonic, fixturePassphrase) -emptyRandomWalletWithPasswd :: Context t -> Text -> IO ApiByronWallet +emptyRandomWalletWithPasswd + :: (MonadIO m, MonadCatch m) + => Context t + -> Text + -> ResourceT m ApiByronWallet emptyRandomWalletWithPasswd ctx rawPwd = do let pwd = preparePassphrase W.EncryptWithScrypt $ Passphrase $ BA.convert $ T.encodeUtf8 rawPwd - seed <- SomeMnemonic @12 . entropyToMnemonic <$> genEntropy + seed <- liftIO $ SomeMnemonic @12 . entropyToMnemonic <$> genEntropy let key = T.decodeUtf8 $ hex $ Byron.getKey $ Byron.generateKeyFromSeed seed pwd - pwdH <- T.decodeUtf8 . hex <$> encryptPasswordWithScrypt pwd + pwdH <- liftIO $ T.decodeUtf8 . hex <$> encryptPasswordWithScrypt pwd emptyByronWalletFromXPrvWith ctx "random" ("Random Wallet", key, pwdH) where encryptPasswordWithScrypt = @@ -768,12 +812,50 @@ emptyRandomWalletWithPasswd ctx rawPwd = do . CBOR.encodeBytes . BA.convert + +postWallet' + :: (MonadIO m, MonadCatch m) + => Context t + -> Headers + -> Payload + -> ResourceT m (HTTP.Status, Either RequestException ApiWallet) +postWallet' ctx headers payload = snd <$> allocate create (free . snd) + where + create = + request @ApiWallet ctx (Link.postWallet @'Shelley) headers payload + + free (Right w) = void $ request @Aeson.Value ctx + (Link.deleteWallet @'Shelley w) Default Empty + free (Left _) = return () + +postWallet + :: (MonadIO m, MonadCatch m) + => Context t + -> Payload + -> ResourceT m (HTTP.Status, Either RequestException ApiWallet) +postWallet ctx = postWallet' ctx Default + + +postByronWallet + :: (MonadIO m, MonadCatch m) + => Context t + -> Payload + -> ResourceT m (HTTP.Status, Either RequestException ApiByronWallet) +postByronWallet ctx payload = snd <$> allocate create (free . snd) + where + create = + request @ApiByronWallet ctx (Link.postWallet @'Byron) Default payload + + free (Right w) = void $ request @Aeson.Value ctx + (Link.deleteWallet @'Byron w) Default Empty + free (Left _) = return () + emptyByronWalletWith - :: forall t. () + :: forall t m. (MonadIO m, MonadCatch m) => Context t -> String -> (Text, [Text], Text) - -> IO ApiByronWallet + -> ResourceT m ApiByronWallet emptyByronWalletWith ctx style (name, mnemonic, pass) = do let payload = Json [aesonQQ| { "name": #{name}, @@ -781,17 +863,16 @@ emptyByronWalletWith ctx style (name, mnemonic, pass) = do "passphrase": #{pass}, "style": #{style} }|] - r <- request @ApiByronWallet ctx - (Link.postWallet @'Byron) Default payload - expectResponseCode @IO HTTP.status201 r + r <- postByronWallet ctx payload + expectResponseCode HTTP.status201 r return (getFromResponse id r) emptyByronWalletFromXPrvWith - :: forall t. () + :: forall t m. (MonadIO m, MonadCatch m) => Context t -> String -> (Text, Text, Text) - -> IO ApiByronWallet + -> ResourceT m ApiByronWallet emptyByronWalletFromXPrvWith ctx style (name, key, passHash) = do let payload = Json [aesonQQ| { "name": #{name}, @@ -799,51 +880,58 @@ emptyByronWalletFromXPrvWith ctx style (name, key, passHash) = do "passphrase_hash": #{passHash}, "style": #{style} }|] - r <- request @ApiByronWallet ctx - (Link.postWallet @'Byron) Default payload - expectResponseCode @IO HTTP.status201 r + r <- postByronWallet ctx payload + expectResponseCode HTTP.status201 r return (getFromResponse id r) -- | Create an empty wallet -emptyWallet :: Context t -> IO ApiWallet +emptyWallet + :: (MonadIO m, MonadCatch m) + => Context t + -> ResourceT m ApiWallet emptyWallet ctx = do - mnemonic <- (mnemonicToText . entropyToMnemonic) <$> genEntropy @160 + mnemonic <- liftIO $ (mnemonicToText . entropyToMnemonic) <$> genEntropy @160 let payload = Json [aesonQQ| { "name": "Empty Wallet", "mnemonic_sentence": #{mnemonic}, "passphrase": #{fixturePassphrase} }|] - r <- request @ApiWallet ctx - (Link.postWallet @'Shelley) Default payload - expectResponseCode @IO HTTP.status201 r + r <- postWallet ctx payload + expectResponseCode HTTP.status201 r return (getFromResponse id r) -- | Create an empty wallet -emptyWalletWith :: Context t -> (Text, Text, Int) -> IO ApiWallet +emptyWalletWith + :: (MonadIO m, MonadCatch m) + => Context t + -> (Text, Text, Int) + -> ResourceT m ApiWallet emptyWalletWith ctx (name, passphrase, addrPoolGap) = do - mnemonic <- (mnemonicToText . entropyToMnemonic) <$> genEntropy @160 + mnemonic <- liftIO $ (mnemonicToText . entropyToMnemonic) <$> genEntropy @160 let payload = Json [aesonQQ| { "name": #{name}, "mnemonic_sentence": #{mnemonic}, "passphrase": #{passphrase}, "address_pool_gap" : #{addrPoolGap} }|] - r <- request @ApiWallet ctx - (Link.postWallet @'Shelley) Default payload - expectResponseCode @IO HTTP.status201 r + r <- postWallet ctx payload + expectResponseCode HTTP.status201 r return (getFromResponse id r) -rewardWallet :: Context t -> IO (ApiWallet, Mnemonic 24) +rewardWallet + :: (MonadIO m, MonadCatch m, MonadFail m) + => Context t + -> ResourceT m (ApiWallet, Mnemonic 24) rewardWallet ctx = do - mw <- nextWallet @"reward" (_faucet ctx) + mw <- liftIO $ nextWallet @"reward" (_faucet ctx) let mnemonic = mnemonicToText mw let payload = Json [aesonQQ|{ "name": "MIR Wallet", "mnemonic_sentence": #{mnemonic}, "passphrase": #{fixturePassphrase} }|] - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload - expectResponseCode @IO HTTP.status201 r + r <- postWallet ctx payload + expectResponseCode HTTP.status201 r let w = getFromResponse id r waitForNextEpoch ctx eventually "MIR wallet: wallet is 100% synced " $ do @@ -876,30 +964,41 @@ fixturePassphraseEncrypted = \51303054356c654751794279732f7662753367526d726c316c657a7150\ \43676d364e6758476d4d2f4b6438343265304b4945773d3d" + -- | Restore a faucet and wait until funds are available. +-- +-- Note: @ResourceT@ is used to allow automatic garbage collection of unused +-- wallets through small blocks of @runResourceT@ (e.g. once per test). It +-- doesn't return @ReleaseKey@ since manual releasing is not needed. fixtureWallet - :: Context t - -> IO ApiWallet + :: MonadIO m + => Context t + -> ResourceT m ApiWallet fixtureWallet ctx = do (w, _) <- fixtureWalletWithMnemonics ctx return w fixtureWalletWithMnemonics - :: Context t - -> IO (ApiWallet, [Text]) -fixtureWalletWithMnemonics ctx = do - mnemonics <- mnemonicToText <$> nextWallet @"shelley" (_faucet ctx) - let payload = Json [aesonQQ| { - "name": "Faucet Wallet", - "mnemonic_sentence": #{mnemonics}, - "passphrase": #{fixturePassphrase} - } |] - (_, w) <- unsafeRequest @ApiWallet ctx - (Link.postWallet @'Shelley) payload - race (threadDelay sixtySeconds) (checkBalance w) >>= \case - Left _ -> fail "fixtureWallet: waited too long for initial transaction" - Right a -> return (a, mnemonics) + :: MonadIO m + => Context t + -> ResourceT m (ApiWallet, [Text]) +fixtureWalletWithMnemonics ctx = snd <$> allocate create (free . fst) where + create = do + mnemonics <- mnemonicToText <$> nextWallet @"shelley" (_faucet ctx) + let payload = Json [aesonQQ| { + "name": "Faucet Wallet", + "mnemonic_sentence": #{mnemonics}, + "passphrase": #{fixturePassphrase} + } |] + (_, w) <- unsafeRequest @ApiWallet ctx + (Link.postWallet @'Shelley) payload + race (threadDelay sixtySeconds) (checkBalance w) >>= \case + Left _ -> fail "fixtureWallet: waited too long for initial transaction" + Right a -> return (a, mnemonics) + + free w = void $ request @Aeson.Value ctx + (Link.deleteWallet @'Shelley w) Default Empty sixtySeconds = 60*oneSecond checkBalance w = do r <- request @ApiWallet ctx @@ -910,23 +1009,27 @@ fixtureWalletWithMnemonics ctx = do -- | Restore a faucet Random wallet and wait until funds are available. fixtureRandomWalletMws - :: Context t - -> IO (ApiByronWallet, Mnemonic 12) + :: (MonadIO m, MonadCatch m) + => Context t + -> ResourceT m (ApiByronWallet, Mnemonic 12) fixtureRandomWalletMws ctx = do - mnemonics <- nextWallet @"random" (_faucet ctx) + mnemonics <- liftIO $ nextWallet @"random" (_faucet ctx) (,mnemonics) <$> fixtureLegacyWallet ctx "random" (mnemonicToText mnemonics) fixtureRandomWallet - :: Context t - -> IO ApiByronWallet + :: (MonadIO m, MonadCatch m) + => Context t + -> ResourceT m ApiByronWallet fixtureRandomWallet = fmap fst . fixtureRandomWalletMws fixtureRandomWalletAddrs - :: forall (n :: NetworkDiscriminant) t. + :: forall (n :: NetworkDiscriminant) t m. ( PaymentAddress n ByronKey + , MonadIO m + , MonadCatch m ) => Context t - -> IO (ApiByronWallet, [Address]) + -> ResourceT m (ApiByronWallet, [Address]) fixtureRandomWalletAddrs = fmap (second (randomAddresses @n)) . fixtureRandomWalletMws @@ -939,22 +1042,24 @@ fixtureRandomWalletAddrs = -- -- TODO: Remove duplication between Shelley / Byron fixtures. fixtureRandomWalletWith - :: forall (n :: NetworkDiscriminant) t. + :: forall (n :: NetworkDiscriminant) t m. ( EncodeAddress n , DecodeAddress n , DecodeStakeAddress n , PaymentAddress n ByronKey + , MonadIO m + , MonadCatch m ) => Context t -> [Natural] - -> IO ApiByronWallet + -> ResourceT m ApiByronWallet fixtureRandomWalletWith ctx coins0 = do src <- fixtureRandomWallet ctx - mws <- entropyToMnemonic <$> genEntropy + mws <- liftIO $ entropyToMnemonic <$> genEntropy dest <- emptyByronWalletWith ctx "random" ("Random Wallet", mnemonicToText @12 mws, fixturePassphrase) let addrs = randomAddresses @n mws - mapM_ (moveByronCoins @n ctx src (dest, addrs)) (groupsOf 10 coins0) + liftIO $ mapM_ (moveByronCoins @n ctx src (dest, addrs)) (groupsOf 10 coins0) void $ request @() ctx (Link.deleteWallet @'Byron src) Default Empty snd <$> unsafeRequest @ApiByronWallet ctx @@ -962,23 +1067,27 @@ fixtureRandomWalletWith ctx coins0 = do -- | Restore a faucet Icarus wallet and wait until funds are available. fixtureIcarusWalletMws - :: Context t - -> IO (ApiByronWallet, Mnemonic 15) + :: (MonadIO m, MonadCatch m) + => Context t + -> ResourceT m (ApiByronWallet, Mnemonic 15) fixtureIcarusWalletMws ctx = do - mnemonics <- nextWallet @"icarus" (_faucet ctx) + mnemonics <- liftIO $ nextWallet @"icarus" (_faucet ctx) (,mnemonics) <$> fixtureLegacyWallet ctx "icarus" (mnemonicToText mnemonics) fixtureIcarusWallet - :: Context t - -> IO ApiByronWallet + :: (MonadIO m, MonadCatch m) + => Context t + -> ResourceT m ApiByronWallet fixtureIcarusWallet = fmap fst . fixtureIcarusWalletMws fixtureIcarusWalletAddrs - :: forall (n :: NetworkDiscriminant) t. + :: forall (n :: NetworkDiscriminant) t m. ( PaymentAddress n IcarusKey + , MonadIO m + , MonadCatch m ) => Context t - -> IO (ApiByronWallet, [Address]) + -> ResourceT m (ApiByronWallet, [Address]) fixtureIcarusWalletAddrs = fmap (second (icarusAddresses @n)) . fixtureIcarusWalletMws @@ -991,22 +1100,24 @@ fixtureIcarusWalletAddrs = -- -- TODO: Remove duplication between Shelley / Byron fixtures. fixtureIcarusWalletWith - :: forall (n :: NetworkDiscriminant) t. + :: forall (n :: NetworkDiscriminant) t m. ( EncodeAddress n , DecodeAddress n , DecodeStakeAddress n , PaymentAddress n IcarusKey + , MonadIO m + , MonadCatch m ) => Context t -> [Natural] - -> IO ApiByronWallet + -> ResourceT m ApiByronWallet fixtureIcarusWalletWith ctx coins0 = do src <- fixtureIcarusWallet ctx - mws <- entropyToMnemonic <$> genEntropy + mws <- liftIO $ entropyToMnemonic <$> genEntropy dest <- emptyByronWalletWith ctx "icarus" ("Icarus Wallet", mnemonicToText @15 mws, fixturePassphrase) let addrs = icarusAddresses @n mws - mapM_ (moveByronCoins @n ctx src (dest, addrs)) (groupsOf 10 coins0) + liftIO $ mapM_ (moveByronCoins @n ctx src (dest, addrs)) (groupsOf 10 coins0) void $ request @() ctx (Link.deleteWallet @'Byron src) Default Empty snd <$> unsafeRequest @ApiByronWallet ctx @@ -1015,26 +1126,31 @@ fixtureIcarusWalletWith ctx coins0 = do -- | Restore a legacy wallet (Byron or Icarus) fixtureLegacyWallet - :: forall t. () + :: forall t m. (MonadIO m, MonadCatch m) => Context t -> String -> [Text] - -> IO ApiByronWallet -fixtureLegacyWallet ctx style mnemonics = do - let payload = Json [aesonQQ| { - "name": "Faucet Byron Wallet", - "mnemonic_sentence": #{mnemonics}, - "passphrase": #{fixturePassphrase}, - "style": #{style} - } |] - (_, w) <- unsafeRequest @ApiByronWallet ctx - (Link.postWallet @'Byron) payload - race (threadDelay sixtySeconds) (checkBalance w) >>= \case - Left _ -> - fail "fixtureByronWallet: waited too long for initial transaction" - Right a -> - return a + -> ResourceT m ApiByronWallet +fixtureLegacyWallet ctx style mnemonics = snd <$> allocate create free where + create = do + let payload = Json [aesonQQ| { + "name": "Faucet Byron Wallet", + "mnemonic_sentence": #{mnemonics}, + "passphrase": #{fixturePassphrase}, + "style": #{style} + } |] + (_, w) <- unsafeRequest @ApiByronWallet ctx + (Link.postWallet @'Byron) payload + liftIO $ race (threadDelay sixtySeconds) (checkBalance w) >>= \case + Left _ -> + fail "fixtureByronWallet: waited too long for initial transaction" + Right a -> + return a + free w = do + void $ request @() ctx + (Link.deleteWallet @'Byron w) Default Empty + sixtySeconds = 60*oneSecond checkBalance w = do r <- request @ApiByronWallet ctx @@ -1050,19 +1166,21 @@ fixtureLegacyWallet ctx style mnemonics = do -- This function makes no attempt at ensuring the request is valid, so be -- careful. fixtureWalletWith - :: forall n t. + :: forall n t m. ( EncodeAddress n , DecodeAddress n , DecodeStakeAddress n + , MonadIO m + , MonadCatch m ) => Context t -> [Natural] - -> IO ApiWallet + -> ResourceT m ApiWallet fixtureWalletWith ctx coins0 = do src <- fixtureWallet ctx dest <- emptyWallet ctx - mapM_ (moveCoins src dest) (groupsOf 10 coins0) - void $ request @() ctx + liftIO $ mapM_ (moveCoins src dest) (groupsOf 10 coins0) + liftIO $ void $ request @() ctx (Link.deleteWallet @'Shelley src) Default Empty snd <$> unsafeRequest @ApiWallet ctx (Link.getWallet @'Shelley dest) Empty @@ -1192,15 +1310,17 @@ json :: QuasiQuoter json = aesonQQ joinStakePool - :: forall n t w. + :: forall n t w m. ( HasType (ApiT WalletId) w , DecodeAddress n , DecodeStakeAddress n + , MonadIO m + , MonadCatch m ) => Context t -> ApiT PoolId -> (w, Text) - -> IO (HTTP.Status, Either RequestException (ApiTransaction n)) + -> m (HTTP.Status, Either RequestException (ApiTransaction n)) joinStakePool ctx p (w, pass) = do let payload = Json [aesonQQ| { "passphrase": #{pass} @@ -1209,14 +1329,16 @@ joinStakePool ctx p (w, pass) = do (Link.joinStakePool (Identity p) w) Default payload quitStakePool - :: forall n t w. + :: forall n t w m. ( HasType (ApiT WalletId) w , DecodeAddress n , DecodeStakeAddress n + , MonadIO m + , MonadCatch m ) => Context t -> (w, Text) - -> IO (HTTP.Status, Either RequestException (ApiTransaction n)) + -> m (HTTP.Status, Either RequestException (ApiTransaction n)) quitStakePool ctx (w, pass) = do let payload = Json [aesonQQ| { "passphrase": #{pass} @@ -1224,6 +1346,7 @@ quitStakePool ctx (w, pass) = do request @(ApiTransaction n) ctx (Link.quitStakePool w) Default payload +-- TODO: Convert to MonadIO selectCoins :: forall n style t w. ( HasType (ApiT WalletId) w @@ -1243,10 +1366,10 @@ selectCoins ctx w payments = do (Link.selectCoins @style w) Default payload delegationFee - :: forall t w. (HasType (ApiT WalletId) w) + :: forall t w m. (HasType (ApiT WalletId) w, MonadIO m, MonadCatch m) => Context t -> w - -> IO (HTTP.Status, Either RequestException ApiFee) + -> m (HTTP.Status, Either RequestException ApiFee) delegationFee ctx w = do request @ApiFee ctx (Link.getDelegationFee w) Default Empty @@ -1326,39 +1449,43 @@ shelleyAddresses mw = ] listAddresses - :: forall n t. (DecodeAddress n) + :: forall n t m. (MonadIO m, MonadCatch m, DecodeAddress n) => Context t -> ApiWallet - -> IO [ApiAddress n] + -> m [ApiAddress n] listAddresses ctx w = do let link = Link.listAddresses @'Shelley w (_, addrs) <- unsafeRequest @[ApiAddress n] ctx link Empty return addrs listAllTransactions - :: forall n t w. + :: forall n t w m. ( DecodeAddress n , DecodeStakeAddress n , HasType (ApiT WalletId) w + , MonadIO m + , MonadCatch m ) => Context t -> w - -> IO [ApiTransaction n] + -> m [ApiTransaction n] listAllTransactions ctx w = listTransactions ctx w Nothing Nothing (Just Descending) listTransactions - :: forall n t w. + :: forall n t w m. ( DecodeAddress n , DecodeStakeAddress n , HasType (ApiT WalletId) w + , MonadIO m + , MonadCatch m ) => Context t -> w -> Maybe UTCTime -> Maybe UTCTime -> Maybe SortOrder - -> IO [ApiTransaction n] + -> m [ApiTransaction n] listTransactions ctx wallet mStart mEnd mOrder = do (_, txs) <- unsafeRequest @[ApiTransaction n] ctx path Empty return txs @@ -1391,10 +1518,10 @@ tearDown ctx = do -- | Wait for a booting wallet server to start. Wait up to 30s or fail. waitForServer - :: forall t ctx. (HasType (Port "wallet") ctx, KnownCommand t) + :: forall t ctx m. (HasType (Port "wallet") ctx, KnownCommand t, MonadIO m) => ctx - -> IO () -waitForServer ctx = void $ retrying + -> m () +waitForServer ctx = liftIO $ void $ retrying (capDelay (30*oneSecond) $ constantDelay oneSecond) -- NOTE -- We still bind the output and error streams to some custom handles because @@ -1483,33 +1610,33 @@ class KnownCommand t where -- | Run a command using the 'cardano-wallet' executable for the target @t@. cardanoWalletCLI - :: forall t r. (CmdResult r, KnownCommand t) + :: forall t r m. (CmdResult r, KnownCommand t, MonadIO m) => [String] - -> IO r -cardanoWalletCLI = command [] (commandName @t) + -> m r +cardanoWalletCLI = liftIO . command [] (commandName @t) generateMnemonicsViaCLI - :: forall t r. (CmdResult r, KnownCommand t) + :: forall t r m. (CmdResult r, KnownCommand t, MonadIO m) => [String] - -> IO r + -> m r generateMnemonicsViaCLI args = cardanoWalletCLI @t (["recovery-phrase", "generate"] ++ args) createWalletViaCLI - :: forall t s. (HasType (Port "wallet") s, KnownCommand t) + :: forall t s m. (HasType (Port "wallet") s, KnownCommand t, MonadIO m) => s -> [String] -> String -> String -> String - -> IO (ExitCode, String, Text) + -> m (ExitCode, String, Text) createWalletViaCLI ctx args mnemonics secondFactor passphrase = do let portArgs = [ "--port", show (ctx ^. typed @(Port "wallet")) ] let fullArgs = [ "wallet", "create", "from-recovery-phrase" ] ++ portArgs ++ args let process = proc' (commandName @t) fullArgs - withCreateProcess process $ + liftIO $ withCreateProcess process $ \(Just stdin) (Just stdout) (Just stderr) h -> do hPutStr stdin mnemonics hPutStr stdin secondFactor @@ -1523,47 +1650,66 @@ createWalletViaCLI ctx args mnemonics secondFactor passphrase = do return (c, T.unpack out, err) createWalletFromPublicKeyViaCLI - :: forall t r s. (CmdResult r, HasType (Port "wallet") s, KnownCommand t) + :: forall t r s m. + ( CmdResult r + , HasType (Port "wallet") s + , KnownCommand t + , MonadIO m + ) => s -> [String] -- ^ NAME, [--address-pool-gap INT], ACCOUNT_PUBLIC_KEY - -> IO r + -> m r createWalletFromPublicKeyViaCLI ctx args = cardanoWalletCLI @t $ [ "wallet", "create", "from-public-key", "--port" , show (ctx ^. typed @(Port "wallet"))] ++ args deleteWalletViaCLI - :: forall t r s. (CmdResult r, KnownCommand t, HasType (Port "wallet") s) + :: forall t r s m. + ( CmdResult r + , KnownCommand t + , HasType (Port "wallet") s + , MonadIO m + ) => s -> String - -> IO r + -> m r deleteWalletViaCLI ctx walId = cardanoWalletCLI @t ["wallet", "delete", "--port", show (ctx ^. typed @(Port "wallet")), walId ] getWalletViaCLI - :: forall t r s. (CmdResult r, KnownCommand t, HasType (Port "wallet") s) + :: forall t r s m. + ( CmdResult r + , KnownCommand t + , HasType (Port "wallet") s + , MonadIO m + ) => s -> String - -> IO r + -> m r getWalletViaCLI ctx walId = cardanoWalletCLI @t ["wallet", "get", "--port", show (ctx ^. typed @(Port "wallet")) , walId ] getWalletUtxoStatisticsViaCLI - :: forall t r s. (CmdResult r, KnownCommand t, HasType (Port "wallet") s) + :: forall t r s m. + ( CmdResult r + , KnownCommand t + , HasType (Port "wallet") s + , MonadIO m) => s -> String - -> IO r + -> m r getWalletUtxoStatisticsViaCLI ctx walId = cardanoWalletCLI @t ["wallet", "utxo", "--port", show (ctx ^. typed @(Port "wallet")) , walId ] createAddressViaCLI - :: forall t s. (KnownCommand t, HasType (Port "wallet") s) + :: forall t s m. (KnownCommand t, HasType (Port "wallet") s, MonadIO m) => s -> [String] -- ^ Args -> String -- ^ Pass - -> IO (ExitCode, Text, Text) + -> m (ExitCode, Text, Text) -- ^ (ExitCode, StdOut, StdErr) createAddressViaCLI ctx args pass = do let execArgs = @@ -1571,7 +1717,7 @@ createAddressViaCLI ctx args pass = do , "--port", show (ctx ^. typed @(Port "wallet")) ] ++ args let process = proc' (commandName @t) execArgs - withCreateProcess process $ + liftIO $ withCreateProcess process $ \(Just stdin) (Just stdout) (Just stderr) h -> do hPutStr stdin (pass <> "\n") hFlush stdin @@ -1582,49 +1728,59 @@ createAddressViaCLI ctx args pass = do pure (c, out, err) importAddressViaCLI - :: forall t r s. (CmdResult r, KnownCommand t, HasType (Port "wallet") s) + :: forall t r s m. (CmdResult r, KnownCommand t, HasType (Port "wallet") s, MonadIO m) => s -> [String] -- ^ Args - -> IO r + -> m r -- ^ (ExitCode, StdOut, StdErr) importAddressViaCLI ctx args = cardanoWalletCLI @t $ ["address", "import", "--port", show (ctx ^. typed @(Port "wallet"))] ++ args listAddressesViaCLI - :: forall t r s. (CmdResult r, KnownCommand t, HasType (Port "wallet") s) + :: forall t r s m. (CmdResult r, KnownCommand t, HasType (Port "wallet") s, MonadIO m) => s -> [String] - -> IO r + -> m r listAddressesViaCLI ctx args = cardanoWalletCLI @t $ ["address", "list", "--port", show (ctx ^. typed @(Port "wallet"))] ++ args listStakePoolsViaCLI - :: forall t r s. (CmdResult r, KnownCommand t, HasType (Port "wallet") s) + :: forall t r s m. (CmdResult r, KnownCommand t, HasType (Port "wallet") s, MonadIO m) => s - -> IO r + -> m r listStakePoolsViaCLI ctx = cardanoWalletCLI @t ["stake-pool", "list", "--port", show (ctx ^. typed @(Port "wallet")) ] listWalletsViaCLI - :: forall t r s. (CmdResult r, KnownCommand t, HasType (Port "wallet") s) + :: forall t r s m. + ( CmdResult r + , KnownCommand t + , HasType (Port "wallet") s + , MonadIO m + ) => s - -> IO r + -> m r listWalletsViaCLI ctx = cardanoWalletCLI @t ["wallet", "list", "--port", show (ctx ^. typed @(Port "wallet")) ] updateWalletNameViaCLI - :: forall t r s. (CmdResult r, KnownCommand t, HasType (Port "wallet") s) + :: forall t r s m. + ( CmdResult r + , KnownCommand t + , HasType (Port "wallet") s + , MonadIO m + ) => s -> [String] - -> IO r + -> m r updateWalletNameViaCLI ctx args = cardanoWalletCLI @t (["wallet", "update", "name", "--port", walletPort] ++ args) where walletPort = show (ctx ^. typed @(Port "wallet")) updateWalletPassphraseViaCLI - :: forall t s. (KnownCommand t, HasType (Port "wallet") s) + :: forall t s m. (KnownCommand t, HasType (Port "wallet") s, MonadIO m) => s -> String -- ^ Wallet id @@ -1634,14 +1790,14 @@ updateWalletPassphraseViaCLI -- ^ New passphrase -> String -- ^ New passphrase (repeated for confirmation) - -> IO (ExitCode, Text, Text) + -> m (ExitCode, Text, Text) updateWalletPassphraseViaCLI ctx wid ppOld ppNew ppNewConfirm = do let process = proc' (commandName @t) [ "wallet", "update", "passphrase" , "--port", show (ctx ^. typed @(Port "wallet")) , wid ] - withCreateProcess process $ + liftIO $ withCreateProcess process $ \(Just stdin) (Just stdout) (Just stderr) h -> do hPutStr stdin (ppOld <> "\n") hPutStr stdin (ppNew <> "\n") @@ -1654,18 +1810,18 @@ updateWalletPassphraseViaCLI ctx wid ppOld ppNew ppNewConfirm = do pure (c, out, err) postTransactionViaCLI - :: forall t s. (HasType (Port "wallet") s, KnownCommand t) + :: forall t s m. (HasType (Port "wallet") s, KnownCommand t, MonadIO m) => s -> String -> [String] - -> IO (ExitCode, String, Text) + -> m (ExitCode, String, Text) postTransactionViaCLI ctx passphrase args = do let portArgs = ["--port", show (ctx ^. typed @(Port "wallet"))] let fullArgs = ["transaction", "create"] ++ portArgs ++ args let process = proc' (commandName @t) fullArgs - withCreateProcess process $ + liftIO $ withCreateProcess process $ \(Just stdin) (Just stdout) (Just stderr) h -> do hPutStr stdin (passphrase ++ "\n") hFlush stdin @@ -1682,10 +1838,10 @@ postTransactionViaCLI ctx passphrase args = do return (c, T.unpack out, err) postTransactionFeeViaCLI - :: forall t r s. (CmdResult r, HasType (Port "wallet") s, KnownCommand t) + :: forall t r s m. (CmdResult r, HasType (Port "wallet") s, KnownCommand t, MonadIO m) => s -> [String] - -> IO r + -> m r postTransactionFeeViaCLI ctx args = cardanoWalletCLI @t $ join [ ["transaction", "fees"] , ["--port", show (ctx ^. typed @(Port "wallet"))] @@ -1693,10 +1849,10 @@ postTransactionFeeViaCLI ctx args = cardanoWalletCLI @t $ join ] listTransactionsViaCLI - :: forall t r s . (CmdResult r, HasType (Port "wallet") s, KnownCommand t) + :: forall t r s m. (CmdResult r, HasType (Port "wallet") s, KnownCommand t, MonadIO m) => s -> [String] - -> IO r + -> m r listTransactionsViaCLI ctx args = cardanoWalletCLI @t $ join [ ["transaction", "list"] , ["--port", show (ctx ^. typed @(Port "wallet"))] @@ -1704,10 +1860,10 @@ listTransactionsViaCLI ctx args = cardanoWalletCLI @t $ join ] postExternalTransactionViaCLI - :: forall t r s . (CmdResult r, HasType (Port "wallet") s, KnownCommand t) + :: forall t r s m. (CmdResult r, HasType (Port "wallet") s, KnownCommand t, MonadIO m) => s -> [String] - -> IO r + -> m r postExternalTransactionViaCLI ctx args = cardanoWalletCLI @t $ join [ ["transaction", "submit"] , ["--port", show (ctx ^. typed @(Port "wallet"))] @@ -1715,22 +1871,22 @@ postExternalTransactionViaCLI ctx args = cardanoWalletCLI @t $ join ] deleteTransactionViaCLI - :: forall t r s. (CmdResult r, KnownCommand t, HasType (Port "wallet") s) + :: forall t r s m. (CmdResult r, KnownCommand t, HasType (Port "wallet") s, MonadIO m) => s -> String -> String - -> IO r + -> m r deleteTransactionViaCLI ctx wid tid = cardanoWalletCLI @t $ join [ ["transaction", "forget"] , ["--port", show (ctx ^. typed @(Port "wallet")), wid, tid] ] getTransactionViaCLI - :: forall t r s. (CmdResult r, KnownCommand t, HasType (Port "wallet") s) + :: forall t r s m. (CmdResult r, KnownCommand t, HasType (Port "wallet") s, MonadIO m) => s -> String -> String - -> IO r + -> m r getTransactionViaCLI ctx wid tid = cardanoWalletCLI @t $ join [ ["transaction", "get"] , ["--port", show (ctx ^. typed @(Port "wallet")), wid, tid] @@ -1782,10 +1938,11 @@ pubKeyFromMnemonics mnemonics = -- Helper for delegation statuses -- getSlotParams - :: (Context t) - -> IO (EpochNo, SlotParameters) + :: MonadIO m + => (Context t) + -> m (EpochNo, SlotParameters) getSlotParams ctx = do - r1 <- request @ApiNetworkInformation ctx + r1 <- liftIO $ request @ApiNetworkInformation ctx Link.getNetworkInfo Default Empty let ApiT currentEpoch = view #epochNumber @@ -1793,7 +1950,7 @@ getSlotParams ctx = do $ getFromResponse #networkTip r1 let endpoint = ( "GET", "v2/network/parameters" ) - r2 <- request @ApiNetworkParameters ctx endpoint Default Empty + r2 <- liftIO $ request @ApiNetworkParameters ctx endpoint Default Empty let (Quantity slotL) = getFromResponse #slotLength r2 let (Quantity epochL) = getFromResponse #epochLength r2 let (Quantity coeff) = getFromResponse #activeSlotCoefficient r2 @@ -1841,3 +1998,6 @@ delegating delegating pidActive nexts = (notDelegating nexts) { active = ApiWalletDelegationNext Delegating (Just pidActive) Nothing } + +unsafeResponse :: (HTTP.Status, Either RequestException a) -> a +unsafeResponse = either (error . show) id . snd diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs index b5e90382277..ec489205b4c 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Addresses.hs @@ -37,6 +37,8 @@ import Cardano.Wallet.Primitive.Types ( AddressState (..) ) import Control.Monad ( forM_ ) +import Control.Monad.Trans.Resource + ( ResourceT, runResourceT ) import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.Generics.Product.Positions @@ -119,12 +121,12 @@ scenario_ADDRESS_LIST_01 ( DecodeAddress n , EncodeAddress n ) - => (Context t -> IO ApiByronWallet) + => (Context t -> ResourceT IO ApiByronWallet) -> SpecWith (Context t) -scenario_ADDRESS_LIST_01 fixture = it title $ \ctx -> do +scenario_ADDRESS_LIST_01 fixture = it title $ \ctx -> runResourceT $ do w <- fixture ctx r <- request @[ApiAddress n] ctx (Link.listAddresses @'Byron w) Default Empty - verify r [ expectResponseCode @IO HTTP.status200 ] + verify r [ expectResponseCode HTTP.status200 ] let n = length $ getFromResponse id r forM_ [0..n-1] $ \addrIx -> do expectListField addrIx #state (`shouldBe` ApiT Unused) r @@ -136,16 +138,16 @@ scenario_ADDRESS_LIST_02 ( DecodeAddress n , EncodeAddress n ) - => (Context t -> IO ApiByronWallet) + => (Context t -> ResourceT IO ApiByronWallet) -> SpecWith (Context t) -scenario_ADDRESS_LIST_02 fixture = it title $ \ctx -> do +scenario_ADDRESS_LIST_02 fixture = it title $ \ctx -> runResourceT $ do w <- fixture ctx -- filtering ?state=used rUsed <- request @[ApiAddress n] ctx (Link.listAddresses' @'Byron w (Just Used)) Default Empty verify rUsed - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 10 -- NOTE fixture wallets have 10 faucet UTxOs ] let nUsed = length $ getFromResponse id rUsed @@ -166,14 +168,14 @@ scenario_ADDRESS_LIST_04 ( DecodeAddress n , EncodeAddress n ) - => (Context t -> IO ApiByronWallet) + => (Context t -> ResourceT IO ApiByronWallet) -> SpecWith (Context t) -scenario_ADDRESS_LIST_04 fixture = it title $ \ctx -> do +scenario_ADDRESS_LIST_04 fixture = it title $ \ctx -> runResourceT $ do w <- fixture ctx _ <- request @() ctx (Link.deleteWallet @'Byron w) Default Empty r <- request @[ApiAddress n] ctx (Link.listAddresses @'Byron w) Default Empty verify r - [ expectResponseCode @IO HTTP.status404 + [ expectResponseCode HTTP.status404 , expectErrorMessage $ errMsg404NoWallet $ w ^. walletId ] where @@ -185,12 +187,12 @@ scenario_ADDRESS_CREATE_01 , EncodeAddress n ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_01 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_01 = it title $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let payload = Json [json| { "passphrase": #{fixturePassphrase} }|] r <- request @(ApiAddress n) ctx (Link.postRandomAddress w) Default payload verify r - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField #state (`shouldBe` ApiT Unused) ] where @@ -202,12 +204,12 @@ scenario_ADDRESS_CREATE_02 , EncodeAddress n ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_02 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_02 = it title $ \ctx -> runResourceT $ do w <- emptyIcarusWallet ctx let payload = Json [json| { "passphrase": #{fixturePassphrase} }|] r <- request @(ApiAddress n) ctx (Link.postRandomAddress w) Default payload verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage errMsg403NotAByronWallet ] where @@ -219,12 +221,12 @@ scenario_ADDRESS_CREATE_03 , EncodeAddress n ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_03 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_03 = it title $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let payload = Json [json| { "passphrase": "Give me all your money." }|] r <- request @(ApiAddress n) ctx (Link.postRandomAddress w) Default payload verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage errMsg403WrongPass ] where @@ -236,17 +238,17 @@ scenario_ADDRESS_CREATE_04 , EncodeAddress n ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_04 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_04 = it title $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let payload = Json [json| { "passphrase": #{fixturePassphrase} }|] rA <- request @(ApiAddress n) ctx (Link.postRandomAddress w) Default payload - verify rA [ expectResponseCode @IO HTTP.status201 ] + verify rA [ expectResponseCode HTTP.status201 ] let addr = getFromResponse id rA rL <- request @[ApiAddress n] ctx (Link.listAddresses @'Byron w) Default Empty verify rL - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListField 0 id (`shouldBe` addr) ] where @@ -258,7 +260,7 @@ scenario_ADDRESS_CREATE_05 , EncodeAddress n ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_05 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_05 = it title $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let payload = Json [json| { "passphrase": #{fixturePassphrase} @@ -266,7 +268,7 @@ scenario_ADDRESS_CREATE_05 = it title $ \ctx -> do }|] r <- request @(ApiAddress n) ctx (Link.postRandomAddress w) Default payload verify r - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField #state (`shouldBe` ApiT Unused) ] where @@ -278,17 +280,17 @@ scenario_ADDRESS_CREATE_06 , EncodeAddress n ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_06 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_06 = it title $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let payload = Json [json| { "passphrase": #{fixturePassphrase} , "address_index": 2147483662 }|] r0 <- request @(ApiAddress n) ctx (Link.postRandomAddress w) Default payload - verify r0 [ expectResponseCode @IO HTTP.status201 ] + verify r0 [ expectResponseCode HTTP.status201 ] r1 <- request @(ApiAddress n) ctx (Link.postRandomAddress w) Default payload verify r1 - [ expectResponseCode @IO HTTP.status409 + [ expectResponseCode HTTP.status409 , expectErrorMessage "I already know of such address." ] where @@ -300,9 +302,9 @@ scenario_ADDRESS_IMPORT_01 , EncodeAddress n , PaymentAddress n ByronKey ) - => (Context t -> IO (ApiByronWallet, Mnemonic 12)) + => (Context t -> ResourceT IO (ApiByronWallet, Mnemonic 12)) -> SpecWith (Context t) -scenario_ADDRESS_IMPORT_01 fixture = it title $ \ctx -> do +scenario_ADDRESS_IMPORT_01 fixture = it title $ \ctx -> runResourceT $ do (w, mw) <- fixture ctx -- Get an unused address @@ -311,7 +313,7 @@ scenario_ADDRESS_IMPORT_01 fixture = it title $ \ctx -> do let link = base <> "/" <> encodeAddress @n addr r0 <- request @() ctx ("PUT", link) Default Empty verify r0 - [ expectResponseCode @IO HTTP.status204 + [ expectResponseCode HTTP.status204 ] -- Import it @@ -329,9 +331,9 @@ scenario_ADDRESS_IMPORT_02 , EncodeAddress n , PaymentAddress n IcarusKey ) - => (Context t -> IO (ApiByronWallet, Mnemonic 15)) + => (Context t -> ResourceT IO (ApiByronWallet, Mnemonic 15)) -> SpecWith (Context t) -scenario_ADDRESS_IMPORT_02 fixture = it title $ \ctx -> do +scenario_ADDRESS_IMPORT_02 fixture = it title $ \ctx -> runResourceT $ do (w, mw) <- fixture ctx let addr = icarusAddresses @n mw !! 42 @@ -339,7 +341,7 @@ scenario_ADDRESS_IMPORT_02 fixture = it title $ \ctx -> do let link = base <> "/" <> encodeAddress @n addr r0 <- request @() ctx ("PUT", link) Default Empty verify r0 - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage errMsg403NotAByronWallet ] where @@ -351,9 +353,9 @@ scenario_ADDRESS_IMPORT_03 , EncodeAddress n , PaymentAddress n ByronKey ) - => (Context t -> IO (ApiByronWallet, Mnemonic 12)) + => (Context t -> ResourceT IO (ApiByronWallet, Mnemonic 12)) -> SpecWith (Context t) -scenario_ADDRESS_IMPORT_03 fixture = it title $ \ctx -> do +scenario_ADDRESS_IMPORT_03 fixture = it title $ \ctx -> runResourceT $ do (w, mw) <- fixture ctx -- Get an unused address @@ -363,9 +365,9 @@ scenario_ADDRESS_IMPORT_03 fixture = it title $ \ctx -> do -- Insert it twice r0 <- request @() ctx ("PUT", link) Default Empty - verify r0 [ expectResponseCode @IO HTTP.status204 ] + verify r0 [ expectResponseCode HTTP.status204 ] r1 <- request @() ctx ("PUT", link) Default Empty - verify r1 [ expectResponseCode @IO HTTP.status204 ] + verify r1 [ expectResponseCode HTTP.status204 ] where title = "ADDRESS_IMPORT_03 - I can import an unused address multiple times" @@ -375,9 +377,9 @@ scenario_ADDRESS_IMPORT_04 , EncodeAddress n , PaymentAddress n ByronKey ) - => (Context t -> IO ApiByronWallet) + => (Context t -> ResourceT IO ApiByronWallet) -> SpecWith (Context t) -scenario_ADDRESS_IMPORT_04 fixture = it title $ \ctx -> do +scenario_ADDRESS_IMPORT_04 fixture = it title $ \ctx -> runResourceT $ do w <- fixture ctx -- Get a used address @@ -389,7 +391,7 @@ scenario_ADDRESS_IMPORT_04 fixture = it title $ \ctx -> do let (_, base) = Link.postRandomAddress w let link = base <> "/" <> toUrlPiece (addr ^. #id) r1 <- request @() ctx ("PUT", link) Default Empty - verify r1 [ expectResponseCode @IO HTTP.status204 ] + verify r1 [ expectResponseCode HTTP.status204 ] -- Verify that the address is unchanged r2 <- request @[ApiAddress n] ctx @@ -405,9 +407,9 @@ scenario_ADDRESS_IMPORT_05 , PaymentAddress n ByronKey ) => Int - -> (Context t -> IO (ApiByronWallet, Mnemonic 12)) + -> (Context t -> ResourceT IO (ApiByronWallet, Mnemonic 12)) -> SpecWith (Context t) -scenario_ADDRESS_IMPORT_05 addrNum fixture = it title $ \ctx -> do +scenario_ADDRESS_IMPORT_05 addrNum fixture = it title $ \ctx -> runResourceT $ do (w, mw) <- fixture ctx -- Get unused addrNum addresses @@ -421,7 +423,7 @@ scenario_ADDRESS_IMPORT_05 addrNum fixture = it title $ \ctx -> do r0 <- request @(ApiPutAddressesData n) ctx ep Default payload verify r0 - [ expectResponseCode @IO HTTP.status204 + [ expectResponseCode HTTP.status204 ] eventually "Addresses are imported" $ do @@ -438,9 +440,9 @@ scenario_ADDRESS_IMPORT_06 , EncodeAddress n , PaymentAddress n ByronKey ) - => (Context t -> IO (ApiByronWallet, Mnemonic 12)) + => (Context t -> ResourceT IO (ApiByronWallet, Mnemonic 12)) -> SpecWith (Context t) -scenario_ADDRESS_IMPORT_06 fixture = it title $ \ctx -> do +scenario_ADDRESS_IMPORT_06 fixture = it title $ \ctx -> runResourceT $ do (w, _) <- fixture ctx (_, mw2) <- fixture ctx @@ -450,7 +452,7 @@ scenario_ADDRESS_IMPORT_06 fixture = it title $ \ctx -> do let link = base <> "/" <> encodeAddress @n addr r0 <- request @() ctx ("PUT", link) Default Empty verify r0 - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage errMsg403CouldntIdentifyAddrAsMine ] where diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/HWWallets.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/HWWallets.hs index bd6ff7100af..ca9b1443318 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/HWWallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/HWWallets.hs @@ -48,6 +48,10 @@ import Cardano.Wallet.Primitive.Types ( AddressState (..) ) import Control.Monad ( forM_ ) +import Control.Monad.IO.Class + ( liftIO ) +import Control.Monad.Trans.Resource + ( runResourceT ) import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.List.NonEmpty @@ -102,10 +106,10 @@ spec :: forall n t. , PaymentAddress n IcarusKey ) => SpecWith (Context t) spec = describe "BYRON_HW_WALLETS" $ do - it "HW_WALLETS_01 - Restoration from account public key preserves funds" $ \ctx -> do + it "HW_WALLETS_01 - Restoration from account public key preserves funds" $ \ctx -> runResourceT $ do wSrc <- fixtureIcarusWallet ctx -- create wallet - mnemonics <- entropyToMnemonic <$> genEntropy + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let mnemonicTxt = mnemonicToText @15 mnemonics let payldCrt = Json [json| { "name": "!st created", @@ -115,7 +119,7 @@ spec = describe "BYRON_HW_WALLETS" $ do }|] rInit <- request @ApiByronWallet ctx (Link.postWallet @'Byron) Default payldCrt verify rInit - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField (#balance . #available) (`shouldBe` Quantity 0) , expectField (#balance . #total) (`shouldBe` Quantity 0) ] @@ -136,7 +140,7 @@ spec = describe "BYRON_HW_WALLETS" $ do }|] rTrans <- request @(ApiTransaction n) ctx (Link.createTransaction @'Byron wSrc) Default payload - expectResponseCode @IO HTTP.status202 rTrans + expectResponseCode HTTP.status202 rTrans eventually "Wallet balance is as expected" $ do rGet <- request @ApiByronWallet ctx @@ -151,7 +155,7 @@ spec = describe "BYRON_HW_WALLETS" $ do -- delete wallet rDel <- request @ApiByronWallet ctx (Link.deleteWallet @'Byron wDest) Default Empty - expectResponseCode @IO HTTP.status204 rDel + expectResponseCode HTTP.status204 rDel -- restore from account public key and make sure funds are there let accXPub = pubKeyFromMnemonics mnemonics @@ -168,11 +172,11 @@ spec = describe "BYRON_HW_WALLETS" $ do ] describe "HW_WALLETS_03 - Cannot do operations requiring private key" $ do - it "Cannot send tx" $ \ctx -> do + it "Cannot send tx" $ \ctx -> runResourceT $ do (w, mnemonics) <- fixtureIcarusWalletMws ctx let pubKey = pubKeyFromMnemonics mnemonics r <- request @ApiByronWallet ctx (Link.deleteWallet @'Byron w) Default Empty - expectResponseCode @IO HTTP.status204 r + expectResponseCode HTTP.status204 r wSrc <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName @@ -190,11 +194,11 @@ spec = describe "BYRON_HW_WALLETS" $ do }|] rTrans <- request @(ApiTransaction n) ctx (Link.createTransaction @'Byron wSrc) Default payload - expectResponseCode @IO HTTP.status403 rTrans + expectResponseCode HTTP.status403 rTrans expectErrorMessage (errMsg403NoRootKey $ wSrc ^. walletId) rTrans - it "Cannot update pass" $ \ctx -> do - mnemonics <- entropyToMnemonic <$> genEntropy + it "Cannot update pass" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wk <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName @@ -202,12 +206,12 @@ spec = describe "BYRON_HW_WALLETS" $ do let payload = updatePassPayload fixturePassphrase "new-wallet-passphrase" rup <- request @ApiByronWallet ctx (Link.putWalletPassphrase @'Byron wk) Default payload - expectResponseCode @IO HTTP.status403 rup + expectResponseCode HTTP.status403 rup expectErrorMessage (errMsg403NoRootKey $ wk ^. walletId) rup describe "HW_WALLETS_04 - Can manage HW wallet the same way as others" $ do - it "Can update name" $ \ctx -> do - mnemonics <- entropyToMnemonic <$> genEntropy + it "Can update name" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wk <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName @@ -215,7 +219,7 @@ spec = describe "BYRON_HW_WALLETS" $ do let newName = "new name" let payload = updateNamePayload newName rup <- request @ApiByronWallet ctx (Link.putWallet @'Byron wk) Default payload - expectResponseCode @IO HTTP.status200 rup + expectResponseCode HTTP.status200 rup rGet <- request @ApiByronWallet ctx (Link.getWallet @'Byron wk) Default Empty @@ -224,11 +228,11 @@ spec = describe "BYRON_HW_WALLETS" $ do (`shouldBe` newName) rGet - it "Can get tx fee" $ \ctx -> do + it "Can get tx fee" $ \ctx -> runResourceT $ do (w, mnemonics) <- fixtureIcarusWalletMws ctx let pubKey = pubKeyFromMnemonics mnemonics r <- request @ApiByronWallet ctx (Link.deleteWallet @'Byron w) Default Empty - expectResponseCode @IO HTTP.status204 r + expectResponseCode HTTP.status204 r wSrc <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName @@ -246,40 +250,40 @@ spec = describe "BYRON_HW_WALLETS" $ do rFee <- request @ApiFee ctx (Link.getTransactionFee @'Byron wSrc) Default payload - expectResponseCode @IO HTTP.status202 rFee + expectResponseCode HTTP.status202 rFee - it "Can delete" $ \ctx -> do - mnemonics <- entropyToMnemonic <$> genEntropy + it "Can delete" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wPub <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName r <- request @ApiByronWallet ctx (Link.deleteWallet @'Byron wPub) Default Empty - expectResponseCode @IO HTTP.status204 r + expectResponseCode HTTP.status204 r - it "Can see utxo" $ \ctx -> do - mnemonics <- entropyToMnemonic <$> genEntropy + it "Can see utxo" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wPub <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName rStat <- request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Byron wPub) Default Empty - expectResponseCode @IO HTTP.status200 rStat + expectResponseCode HTTP.status200 rStat expectWalletUTxO [] (snd rStat) - it "Can list addresses" $ \ctx -> do - mnemonics <- entropyToMnemonic <$> genEntropy + it "Can list addresses" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wPub <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName let g = fromIntegral $ getAddressPoolGap defaultAddressPoolGap r <- request @[ApiAddress n] ctx (Link.listAddresses @'Byron wPub) Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r expectListSize g r forM_ [0..(g-1)] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) r - it "Can have address pool gap" $ \ctx -> do - mnemonics <- entropyToMnemonic <$> genEntropy + it "Can have address pool gap" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics let addrPoolGap = 55 --arbitraty but known let payloadRestore = Json [json| { @@ -289,19 +293,19 @@ spec = describe "BYRON_HW_WALLETS" $ do }|] rRestore <- request @ApiByronWallet ctx (Link.postWallet @'Byron) Default payloadRestore - expectResponseCode @IO HTTP.status201 rRestore + expectResponseCode HTTP.status201 rRestore let wPub = getFromResponse id rRestore r <- request @[ApiAddress n] ctx (Link.listAddresses @'Byron wPub) Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r expectListSize addrPoolGap r forM_ [0..(addrPoolGap-1)] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) r - it "Can list transactions" $ \ctx -> do - mnemonics <- entropyToMnemonic <$> genEntropy + it "Can list transactions" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wPub <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName @@ -310,18 +314,18 @@ spec = describe "BYRON_HW_WALLETS" $ do expectResponseCode HTTP.status200 rt expectListSize 0 rt - it "Can get coin selection" $ \ctx -> do + it "Can get coin selection" $ \ctx -> runResourceT $ do (w, mnemonics) <- fixtureIcarusWalletMws ctx let pubKey = pubKeyFromMnemonics mnemonics r <- request @ApiByronWallet ctx (Link.deleteWallet @'Byron w) Default Empty - expectResponseCode @IO HTTP.status204 r + expectResponseCode HTTP.status204 r source <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName let [addr] = take 1 $ icarusAddresses @n mnemonics let amount = Quantity minUTxOValue let payment = AddressAmount (ApiT addr, Proxy @n) amount - selectCoins @n @'Byron ctx source (payment :| []) >>= flip verify + liftIO $ selectCoins @n @'Byron ctx source (payment :| []) >>= flip verify [ expectResponseCode HTTP.status200 , expectField #inputs (`shouldSatisfy` (not . null)) , expectField #outputs (`shouldSatisfy` ((> 1) . length)) @@ -329,8 +333,8 @@ spec = describe "BYRON_HW_WALLETS" $ do ] describe "HW_WALLETS_05 - Wallet from pubKey is available" $ do - it "Can get wallet" $ \ctx -> do - mnemonics <- entropyToMnemonic <$> genEntropy + it "Can get wallet" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wPub <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName rGet <- request @ApiByronWallet ctx @@ -340,9 +344,9 @@ spec = describe "BYRON_HW_WALLETS" $ do (`shouldBe` restoredWalletName) rGet - it "Can list wallet" $ \ctx -> do - pendingWith "TODO: appears to be flaky from time to time." - mnemonics <- entropyToMnemonic <$> genEntropy + it "Can list wallet" $ \ctx -> runResourceT $ do + liftIO $ pendingWith "TODO: appears to be flaky from time to time." + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics _ <- restoreWalletFromPubKey @ApiByronWallet @'Byron ctx pubKey restoredWalletName rl <- request @[ApiByronWallet] ctx @@ -352,9 +356,9 @@ spec = describe "BYRON_HW_WALLETS" $ do (`shouldBe` restoredWalletName) rl - it "The same account and mnemonic wallet can live side-by-side" $ \ctx -> do - pendingWith "TODO: appears to flaky from time to time." - mnemonics <- entropyToMnemonic <$> genEntropy + it "The same account and mnemonic wallet can live side-by-side" $ \ctx -> runResourceT $ do + liftIO $ pendingWith "TODO: appears to flaky from time to time." + mnemonics <- liftIO $ entropyToMnemonic <$> genEntropy let mnemonicsTxt = mnemonicToText @15 mnemonics -- create mnemonic wallet @@ -366,7 +370,7 @@ spec = describe "BYRON_HW_WALLETS" $ do "style": "icarus" }|] r <- request @ApiByronWallet ctx (Link.postWallet @'Byron) Default payldCrt - expectResponseCode @IO HTTP.status201 r + expectResponseCode HTTP.status201 r -- create from account public key let accXPub = pubKeyFromMnemonics mnemonics diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs index f53a0d483ba..a94da70c5c6 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Migrations.hs @@ -39,6 +39,10 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( ShelleyKey ) import Control.Monad ( forM_ ) +import Control.Monad.IO.Class + ( liftIO ) +import Control.Monad.Trans.Resource + ( runResourceT ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.Maybe @@ -73,9 +77,10 @@ import Test.Integration.Framework.DSL , icarusAddresses , json , listAddresses + , postByronWallet , randomAddresses , request - , unsafeRequest + , unsafeResponse , verify , walletId , (.>) @@ -107,30 +112,31 @@ spec = describe "BYRON_MIGRATIONS" $ do it "BYRON_CALCULATE_01 - \ \for non-empty wallet calculated fee is > zero." $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] - $ \fixtureByronWallet -> do + $ \fixtureByronWallet -> runResourceT $ do w <- fixtureByronWallet ctx let ep = Link.getMigrationInfo @'Byron w r <- request @ApiWalletMigrationInfo ctx ep Default Empty verify r - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField (#migrationCost . #getQuantity) (.> 0) ] it "BYRON_CALCULATE_02 - \ \Cannot calculate fee for empty wallet." - $ \ctx -> forM_ [emptyRandomWallet, emptyIcarusWallet] $ \emptyByronWallet -> do + $ \ctx -> forM_ [emptyRandomWallet, emptyIcarusWallet] + $ \emptyByronWallet -> runResourceT $ do w <- emptyByronWallet ctx let ep = Link.getMigrationInfo @'Byron w r <- request @ApiWalletMigrationInfo ctx ep Default Empty verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage (errMsg403NothingToMigrate $ w ^. walletId) ] it "BYRON_CALCULATE_02 - \ \Cannot calculate fee for wallet with dust, that cannot be migrated." - $ \ctx -> do + $ \ctx -> runResourceT $ do -- NOTE -- Special mnemonic for which wallet with dust -- (5 utxo with 60 lovelace) @@ -143,22 +149,21 @@ spec = describe "BYRON_MIGRATIONS" $ do "passphrase": #{fixturePassphrase}, "style": "random" } |] - (_, w) <- unsafeRequest @ApiByronWallet ctx - (Link.postWallet @'Byron) payloadRestore + w <- unsafeResponse <$> postByronWallet ctx payloadRestore let ep = Link.getMigrationInfo @'Byron w r <- request @ApiWalletMigrationInfo ctx ep Default Empty verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage (errMsg403NothingToMigrate $ w ^. walletId) ] it "BYRON_CALCULATE_03 - \ \Cannot estimate migration for Shelley wallet using Byron endpoint" - $ \ctx -> do + $ \ctx -> runResourceT $ do w <- emptyWallet ctx let ep = Link.getMigrationInfo @'Byron w r <- request @ApiWalletMigrationInfo ctx ep Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r describe "BYRON_MIGRATE_05 - I could migrate to any valid address" $ do @@ -166,16 +171,16 @@ spec = describe "BYRON_MIGRATIONS" $ do , ("Icarus", emptyIcarusWallet) ] $ \(walType, destWallet) -> do - it ("From wallet type: " ++ walType) $ \ctx -> do + it ("From wallet type: " ++ walType) $ \ctx -> runResourceT $ do --shelley address wShelley <- emptyWallet ctx addrs <- listAddresses @n ctx wShelley let addrShelley = (addrs !! 1) ^. #id --icarus address - addrIcarus <- encodeAddress @n . head . icarusAddresses @n + addrIcarus <- liftIO $ encodeAddress @n . head . icarusAddresses @n . entropyToMnemonic @15 <$> genEntropy --byron address - addrByron <- encodeAddress @n . head . randomAddresses @n + addrByron <- liftIO $ encodeAddress @n . head . randomAddresses @n . entropyToMnemonic @12 <$> genEntropy sWallet <- destWallet ctx @@ -187,32 +192,32 @@ spec = describe "BYRON_MIGRATIONS" $ do , addresses: [#{addrShelley}, #{addrIcarus}, #{addrByron}] }|]) verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage (errMsg403NothingToMigrate (sWallet ^. walletId)) ] - it "BYRON_MIGRATE_07 - invalid payload, parser error" $ \ctx -> do + it "BYRON_MIGRATE_07 - invalid payload, parser error" $ \ctx -> runResourceT $ do sourceWallet <- emptyRandomWallet ctx r <- request @[ApiTransaction n] ctx (Link.migrateWallet @'Byron sourceWallet) Default (NonJson "{passphrase:,}") - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r expectErrorMessage errMsg400ParseError r it "BYRON_MIGRATE_01 - \ \after a migration operation successfully completes, the correct \ \amount eventually becomes available in the target wallet for arbitrary \ \ number of specified addresses." - $ \ctx -> do + $ \ctx -> runResourceT $ do testAddressCycling ctx 1 testAddressCycling ctx 3 testAddressCycling ctx 10 Hspec.it "BYRON_MIGRATE_01 - \ - \ migrate a big wallet requiring more than one tx" $ \ctx -> do + \ migrate a big wallet requiring more than one tx" $ \ctx -> runResourceT @IO $ do -- NOTE -- Special mnemonic for which 200 legacy funds are attached to in the -- genesis file. @@ -231,8 +236,7 @@ spec = describe "BYRON_MIGRATIONS" $ do "passphrase": #{fixturePassphrase}, "style": "random" } |] - (_, wOld) <- unsafeRequest @ApiByronWallet ctx - (Link.postWallet @'Byron) payloadRestore + wOld <- unsafeResponse <$> postByronWallet ctx payloadRestore originalBalance <- eventually "wallet balance greater than 0" $ do r <- request @ApiByronWallet ctx (Link.getWallet @'Byron wOld) @@ -243,13 +247,13 @@ spec = describe "BYRON_MIGRATIONS" $ do ] return $ getFromResponse (#balance . #available . #getQuantity) r - -- Calculate the expected migration fee: + --Calculate the expected migration fee: rFee <- request @ApiWalletMigrationInfo ctx (Link.getMigrationInfo @'Byron wOld) Default Empty verify rFee - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField #migrationCost (.> Quantity 0) ] let expectedFee = getFromResponse (#migrationCost . #getQuantity) rFee @@ -275,7 +279,7 @@ spec = describe "BYRON_MIGRATIONS" $ do Default payloadMigrate verify rm - [ expectResponseCode @IO HTTP.status202 + [ expectResponseCode HTTP.status202 , expectField id ( (`shouldBe` (numOfTxs)) . length ) ] @@ -305,7 +309,7 @@ spec = describe "BYRON_MIGRATIONS" $ do it "BYRON_MIGRATE_01 - \ \a migration operation removes all funds from the source wallet." $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] - $ \fixtureByronWallet -> do + $ \fixtureByronWallet -> runResourceT $ do -- Restore a Byron wallet with funds, to act as a source wallet: sourceWallet <- fixtureByronWallet ctx @@ -322,7 +326,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , addresses: [#{addr1}] }|]) verify r0 - [ expectResponseCode @IO HTTP.status202 + [ expectResponseCode HTTP.status202 , expectField id (`shouldSatisfy` (not . null)) ] @@ -330,13 +334,14 @@ spec = describe "BYRON_MIGRATIONS" $ do r1 <- request @ApiByronWallet ctx (Link.getWallet @'Byron sourceWallet) Default Empty verify r1 - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField (#balance . #available) (`shouldBe` Quantity 0) ] it "BYRON_MIGRATE_02 - \ \migrating an empty wallet should fail." - $ \ctx -> forM_ [emptyRandomWallet, emptyIcarusWallet] $ \emptyByronWallet -> do + $ \ctx -> forM_ [emptyRandomWallet, emptyIcarusWallet] + $ \emptyByronWallet -> runResourceT $ do sourceWallet <- emptyByronWallet ctx targetWallet <- emptyWallet ctx addrs <- listAddresses @n ctx targetWallet @@ -350,13 +355,13 @@ spec = describe "BYRON_MIGRATIONS" $ do r <- request @[ApiTransaction n] ctx ep Default payload let srcId = sourceWallet ^. walletId verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage (errMsg403NothingToMigrate srcId) ] Hspec.it "BYRON_MIGRATE_02 - \ \migrating wallet with dust should fail." - $ \ctx -> do + $ \ctx -> runResourceT @IO $ do -- NOTE -- Special mnemonic for which wallet with dust -- (5 utxos with 60 lovelace in total) @@ -371,8 +376,7 @@ spec = describe "BYRON_MIGRATIONS" $ do "passphrase": #{fixturePassphrase}, "style": "random" } |] - (_, sourceWallet) <- unsafeRequest @ApiByronWallet ctx - (Link.postWallet @'Byron) payloadRestore + sourceWallet <- unsafeResponse <$> postByronWallet ctx payloadRestore eventually "wallet balance greater than 0" $ do request @ApiByronWallet ctx (Link.getWallet @'Byron sourceWallet) @@ -393,14 +397,14 @@ spec = describe "BYRON_MIGRATIONS" $ do r <- request @[ApiTransaction n] ctx ep Default payload let srcId = sourceWallet ^. walletId verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage (errMsg403NothingToMigrate srcId) ] it "BYRON_MIGRATE_03 - \ \actual fee for migration is the same as the predicted fee." $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] - $ \fixtureByronWallet -> do + $ \fixtureByronWallet -> runResourceT $ do -- Restore a Byron wallet with funds. sourceWallet <- fixtureByronWallet ctx @@ -408,7 +412,7 @@ spec = describe "BYRON_MIGRATIONS" $ do let ep0 = (Link.getMigrationInfo @'Byron sourceWallet) r0 <- request @ApiWalletMigrationInfo ctx ep0 Default Empty verify r0 - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField #migrationCost (.> Quantity 0) ] @@ -424,7 +428,7 @@ spec = describe "BYRON_MIGRATIONS" $ do let ep1 = Link.migrateWallet @'Byron sourceWallet r1 <- request @[ApiTransaction n] ctx ep1 Default payload verify r1 - [ expectResponseCode @IO HTTP.status202 + [ expectResponseCode HTTP.status202 , expectField id (`shouldSatisfy` (not . null)) ] @@ -433,11 +437,11 @@ spec = describe "BYRON_MIGRATIONS" $ do <$> getFromResponse id r1 let predictedFee = getFromResponse (#migrationCost . #getQuantity) r0 - actualFee `shouldBe` predictedFee + liftIO $ actualFee `shouldBe` predictedFee it "BYRON_MIGRATE_04 - migration fails with a wrong passphrase" $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] - $ \fixtureByronWallet -> do + $ \fixtureByronWallet -> runResourceT $ do -- Restore a Byron wallet with funds, to act as a source wallet: sourceWallet <- fixtureByronWallet ctx @@ -453,7 +457,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , addresses: [#{addr1}] }|]) verify r0 - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage errMsg403WrongPass ] @@ -475,7 +479,7 @@ spec = describe "BYRON_MIGRATIONS" $ do testAddressCycling ctx addrNum = forM_ [fixtureRandomWallet, fixtureIcarusWallet] - $ \fixtureByronWallet -> do + $ \fixtureByronWallet -> runResourceT $ do -- Restore a Byron wallet with funds, to act as a source wallet: sourceWallet <- fixtureByronWallet ctx let originalBalance = @@ -492,7 +496,7 @@ spec = describe "BYRON_MIGRATIONS" $ do r0 <- request @ApiWalletMigrationInfo ctx (Link.getMigrationInfo @'Byron sourceWallet) Default Empty verify r0 - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField #migrationCost (.> Quantity 0) ] let expectedFee = getFromResponse (#migrationCost . #getQuantity) r0 @@ -507,7 +511,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , addresses: #{addrIds} }|]) verify r1 - [ expectResponseCode @IO HTTP.status202 + [ expectResponseCode HTTP.status202 , expectField id (`shouldSatisfy` (not . null)) ] diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs index 6f432282586..860cdd6f9d5 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Transactions.hs @@ -24,6 +24,10 @@ import Cardano.Wallet.Api.Types ) import Control.Monad ( forM_ ) +import Control.Monad.IO.Class + ( liftIO ) +import Control.Monad.Trans.Resource + ( runResourceT ) import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.Quantity @@ -49,6 +53,7 @@ import Test.Integration.Framework.DSL , fixturePassphrase , fixtureRandomWallet , json + , postByronWallet , request , toQueryString , verify @@ -74,7 +79,7 @@ spec :: forall n t. ) => SpecWith (Context t) spec = describe "BYRON_MIGRATIONS" $ do - it "BYRON_RESTORE_08 - Icarus wallet with high indexes" $ \ctx -> do + it "BYRON_RESTORE_08 - Icarus wallet with high indexes" $ \ctx -> runResourceT $ do -- NOTE -- Special Icarus mnemonic where address indexes are all after the index -- 500. Because we don't have the whole history, restoring sequential @@ -92,13 +97,13 @@ spec = describe "BYRON_MIGRATIONS" $ do "style": "icarus" } |] - r <- request @ApiByronWallet ctx (Link.postWallet @'Byron) Default payload + r <- postByronWallet ctx payload verify r - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField (#balance . #available) (`shouldBe` Quantity faucetAmt) ] - it "BYRON_RESTORE_09 - Ledger wallet" $ \ctx -> do + it "BYRON_RESTORE_09 - Ledger wallet" $ \ctx -> runResourceT $ do -- NOTE -- Special legacy wallets where addresses have been generated from a -- seed derived using the auxiliary method used by Ledger. @@ -114,30 +119,30 @@ spec = describe "BYRON_MIGRATIONS" $ do "style": "ledger" } |] - r <- request @ApiByronWallet ctx (Link.postWallet @'Byron) Default payload + r <- postByronWallet ctx payload verify r - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField (#balance . #available) (`shouldBe` Quantity faucetAmt) ] it "BYRON_TX_LIST_01 - 0 txs on empty Byron wallet" - $ \ctx -> forM_ [emptyRandomWallet, emptyIcarusWallet] $ \emptyByronWallet -> do + $ \ctx -> runResourceT @IO $ forM_ [emptyRandomWallet, emptyIcarusWallet] $ \emptyByronWallet -> do w <- emptyByronWallet ctx let link = Link.listTransactions @'Byron w r <- request @([ApiTransaction n]) ctx link Default Empty verify r - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 0 ] it "BYRON_TX_LIST_01 - Can list transactions on Byron Wallet" - $ \ctx -> forM_ [fixtureRandomWallet, fixtureIcarusWallet] + $ \ctx -> runResourceT @IO $ forM_ [fixtureRandomWallet, fixtureIcarusWallet] $ \fixtureByronWallet -> do w <- fixtureByronWallet ctx let link = Link.listTransactions @'Byron w r <- request @([ApiTransaction n]) ctx link Default Empty verify r - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 10 ] @@ -151,7 +156,7 @@ spec = describe "BYRON_MIGRATIONS" $ do TestCase { query = toQueryString [ ("start", "2009") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage startEndErr ] @@ -162,7 +167,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , ("end", "2016-11-21") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage startEndErr ] @@ -173,7 +178,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , ("end", "2016-11-21T10:15:00Z") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage startEndErr ] @@ -184,7 +189,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , ("start", "2016-11-21") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage startEndErr ] @@ -192,7 +197,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , TestCase { query = toQueryString [ ("order", "scending") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage orderErr ] @@ -203,7 +208,7 @@ spec = describe "BYRON_MIGRATIONS" $ do , ("order", "asc") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage orderErr ] } @@ -211,14 +216,14 @@ spec = describe "BYRON_MIGRATIONS" $ do let withQuery q (method, link) = (method, link <> q) - forM_ queries $ \tc -> it (T.unpack $ query tc) $ \ctx -> do + forM_ queries $ \tc -> it (T.unpack $ query tc) $ \ctx -> runResourceT @IO $ do w <- emptyRandomWallet ctx let link = withQuery (query tc) $ Link.listTransactions @'Byron w r <- request @([ApiTransaction n]) ctx link Default Empty - verify r (assertions tc) + liftIO $ verify r (assertions tc) it "BYRON_TX_LIST_01 - Start time shouldn't be later than end time" $ - \ctx -> do + \ctx -> runResourceT @IO $ do w <- emptyRandomWallet ctx let startTime = "2009-09-09T09:09:09Z" let endTime = "2001-01-01T01:01:01Z" @@ -228,15 +233,15 @@ spec = describe "BYRON_MIGRATIONS" $ do (either (const Nothing) Just $ fromText $ T.pack endTime) Nothing r <- request @([ApiTransaction n]) ctx link Default Empty - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r expectErrorMessage (errMsg400StartTimeLaterThanEndTime startTime endTime) r - it "BYRON_TX_LIST_04 - Deleted wallet" $ \ctx -> do + it "BYRON_TX_LIST_04 - Deleted wallet" $ \ctx -> runResourceT @IO $ do w <- emptyRandomWallet ctx _ <- request @ApiByronWallet ctx (Link.deleteWallet @'Byron w) Default Empty let link = Link.listTransactions @'Byron w r <- request @([ApiTransaction n]) ctx link Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Wallets.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Wallets.hs index c4c9532d537..c998d10a9a0 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Wallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Byron/Wallets.hs @@ -32,6 +32,10 @@ import Cardano.Wallet.Primitive.SyncProgress ( SyncProgress (..) ) import Control.Monad ( forM_, void ) +import Control.Monad.IO.Class + ( liftIO ) +import Control.Monad.Trans.Resource + ( runResourceT ) import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.Maybe @@ -68,6 +72,7 @@ import Test.Integration.Framework.DSL , genMnemonics , getFromResponse , json + , postByronWallet , request , rootPrvKeyFromMnemonics , verify @@ -97,25 +102,25 @@ spec :: forall n t. , PaymentAddress n ByronKey ) => SpecWith (Context t) spec = describe "BYRON_WALLETS" $ do - it "BYRON_GET_04, DELETE_01 - Deleted wallet is not available" $ \ctx -> do + it "BYRON_GET_04, DELETE_01 - Deleted wallet is not available" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx _ <- request @ApiByronWallet ctx (Link.deleteWallet @'Byron w) Default Empty rg <- request @ApiByronWallet ctx (Link.getWallet @'Byron w) Default Empty - expectResponseCode @IO HTTP.status404 rg + expectResponseCode HTTP.status404 rg expectErrorMessage (errMsg404NoWallet $ w ^. walletId) rg it "BYRON_LIST_01 - Byron Wallets are listed from oldest to newest" $ - \ctx -> do - m1 <- genMnemonics M12 - m2 <- genMnemonics M12 - m3 <- genMnemonics M12 + \ctx -> runResourceT $ do + m1 <- liftIO $ genMnemonics M12 + m2 <- liftIO $ genMnemonics M12 + m3 <- liftIO $ genMnemonics M12 _ <- emptyByronWalletWith ctx "random" ("b1", m1, fixturePassphrase) _ <- emptyByronWalletWith ctx "random" ("b2", m2, fixturePassphrase) _ <- emptyByronWalletWith ctx "random" ("b3", m3, fixturePassphrase) rl <- request @[ApiByronWallet] ctx (Link.listWallets @'Byron) Default Empty verify rl - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 3 , expectListField 0 (#name . #getApiT . #getWalletName) (`shouldBe` "b1") @@ -125,14 +130,14 @@ spec = describe "BYRON_WALLETS" $ do (#name . #getApiT . #getWalletName) (`shouldBe` "b3") ] - it "BYRON_LIST_01 - Interleave of Icarus and Random wallets" $ \ctx -> do + it "BYRON_LIST_01 - Interleave of Icarus and Random wallets" $ \ctx -> runResourceT $ do let pwd = fixturePassphrase - genMnemonics M15 >>= \m -> void (emptyByronWalletWith ctx "icarus" ("ica1", m, pwd)) - genMnemonics M12 >>= \m -> void (emptyByronWalletWith ctx "random" ("rnd2", m, pwd)) - genMnemonics M15 >>= \m -> void (emptyByronWalletWith ctx "icarus" ("ica3", m, pwd)) + liftIO (genMnemonics M15) >>= \m -> void (emptyByronWalletWith ctx "icarus" ("ica1", m, pwd)) + liftIO (genMnemonics M12) >>= \m -> void (emptyByronWalletWith ctx "random" ("rnd2", m, pwd)) + liftIO (genMnemonics M15) >>= \m -> void (emptyByronWalletWith ctx "icarus" ("ica3", m, pwd)) rl <- request @[ApiByronWallet] ctx (Link.listWallets @'Byron) Default Empty verify rl - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 3 , expectListField 0 (#name . #getApiT . #getWalletName) (`shouldBe` "ica1") @@ -143,7 +148,7 @@ spec = describe "BYRON_WALLETS" $ do ] describe "BYRON_RESTORE_01, GET_01, LIST_01 - Restore a wallet" $ do - let scenarioSuccess style mnemonic ctx = do + let scenarioSuccess style mnemonic ctx = runResourceT $ do let name = "Empty Byron Wallet" let payload = Json [json| { "name": #{name}, @@ -163,9 +168,8 @@ spec = describe "BYRON_WALLETS" $ do , expectField #discovery (`shouldBe` discovery) ] -- create - r <- request @ApiByronWallet ctx - (Link.postWallet @'Byron) Default payload - verify r expectations + r <- postByronWallet ctx payload + liftIO $ verify r expectations let w = getFromResponse id r eventually "wallet is available and ready" $ do @@ -178,7 +182,7 @@ spec = describe "BYRON_WALLETS" $ do rl <- request @[ApiByronWallet] ctx (Link.listWallets @'Byron) Default Empty verify rl - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 1 , expectListField 0 (#name . #getApiT . #getWalletName) (`shouldBe` name) @@ -190,17 +194,16 @@ spec = describe "BYRON_WALLETS" $ do (#balance . #total) (`shouldBe` Quantity 0) ] - let scenarioFailure style mnemonic ctx = do + let scenarioFailure style mnemonic ctx = runResourceT $ do let payload = Json [json| { "name": "Empty Byron Wallet", "mnemonic_sentence": #{mnemonic}, "passphrase": #{fixturePassphrase}, "style": #{style} }|] - r <- request @ApiByronWallet ctx - (Link.postWallet @'Byron) Default payload + r <- postByronWallet ctx payload verify r - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage errMsg400NumberOfWords ] @@ -212,60 +215,60 @@ spec = describe "BYRON_WALLETS" $ do , "words" ] - it' "random" (genMnemonics M9) scenarioFailure -- ❌ - it' "random" (genMnemonics M12) scenarioSuccess -- ✔️ - it' "random" (genMnemonics M15) scenarioSuccess -- ✔️ - it' "random" (genMnemonics M18) scenarioSuccess -- ✔️ - it' "random" (genMnemonics M21) scenarioSuccess -- ✔️ - it' "random" (genMnemonics M24) scenarioSuccess -- ✔️ - - it' "icarus" (genMnemonics M9) scenarioFailure -- ❌ - it' "icarus" (genMnemonics M12) scenarioSuccess -- ✔️ - it' "icarus" (genMnemonics M15) scenarioSuccess -- ✔️ - it' "icarus" (genMnemonics M18) scenarioSuccess -- ✔️ - it' "icarus" (genMnemonics M21) scenarioSuccess -- ✔️ - it' "icarus" (genMnemonics M24) scenarioSuccess -- ✔️ - - it' "trezor" (genMnemonics M9) scenarioFailure -- ❌ - it' "trezor" (genMnemonics M12) scenarioSuccess -- ✔️ - it' "trezor" (genMnemonics M15) scenarioSuccess -- ✔️ - it' "trezor" (genMnemonics M18) scenarioSuccess -- ✔️ - it' "trezor" (genMnemonics M21) scenarioSuccess -- ✔️ - it' "trezor" (genMnemonics M24) scenarioSuccess -- ✔️ - - it' "ledger" (genMnemonics M9) scenarioFailure -- ❌ - it' "ledger" (genMnemonics M12) scenarioSuccess -- ✔️ - it' "ledger" (genMnemonics M15) scenarioSuccess -- ✔️ - it' "ledger" (genMnemonics M18) scenarioSuccess -- ✔️ - it' "ledger" (genMnemonics M21) scenarioSuccess -- ✔️ - it' "ledger" (genMnemonics M24) scenarioSuccess -- ✔️ + it' "random" (liftIO $ genMnemonics M9) scenarioFailure -- ❌ + it' "random" (liftIO $ genMnemonics M12) scenarioSuccess -- ✔️ + it' "random" (liftIO $ genMnemonics M15) scenarioSuccess -- ✔️ + it' "random" (liftIO $ genMnemonics M18) scenarioSuccess -- ✔️ + it' "random" (liftIO $ genMnemonics M21) scenarioSuccess -- ✔️ + it' "random" (liftIO $ genMnemonics M24) scenarioSuccess -- ✔️ + + it' "icarus" (liftIO $ genMnemonics M9) scenarioFailure -- ❌ + it' "icarus" (liftIO $ genMnemonics M12) scenarioSuccess -- ✔️ + it' "icarus" (liftIO $ genMnemonics M15) scenarioSuccess -- ✔️ + it' "icarus" (liftIO $ genMnemonics M18) scenarioSuccess -- ✔️ + it' "icarus" (liftIO $ genMnemonics M21) scenarioSuccess -- ✔️ + it' "icarus" (liftIO $ genMnemonics M24) scenarioSuccess -- ✔️ + + it' "trezor" (liftIO $ genMnemonics M9) scenarioFailure -- ❌ + it' "trezor" (liftIO $ genMnemonics M12) scenarioSuccess -- ✔️ + it' "trezor" (liftIO $ genMnemonics M15) scenarioSuccess -- ✔️ + it' "trezor" (liftIO $ genMnemonics M18) scenarioSuccess -- ✔️ + it' "trezor" (liftIO $ genMnemonics M21) scenarioSuccess -- ✔️ + it' "trezor" (liftIO $ genMnemonics M24) scenarioSuccess -- ✔️ + + it' "ledger" (liftIO $ genMnemonics M9) scenarioFailure -- ❌ + it' "ledger" (liftIO $ genMnemonics M12) scenarioSuccess -- ✔️ + it' "ledger" (liftIO $ genMnemonics M15) scenarioSuccess -- ✔️ + it' "ledger" (liftIO $ genMnemonics M18) scenarioSuccess -- ✔️ + it' "ledger" (liftIO $ genMnemonics M21) scenarioSuccess -- ✔️ + it' "ledger" (liftIO $ genMnemonics M24) scenarioSuccess -- ✔️ it "BYRON_RESTORE_02 - One can restore previously deleted wallet" $ - \ctx -> do - m <- genMnemonics M12 + \ctx -> runResourceT $ do + m <- liftIO $ genMnemonics M12 w <- emptyByronWalletWith ctx "random" ("Byron Wallet", m, fixturePassphrase) rd <- request @ApiByronWallet ctx (Link.deleteWallet @'Byron w) Default Empty - expectResponseCode @IO HTTP.status204 rd + expectResponseCode HTTP.status204 rd wr <- emptyByronWalletWith ctx "random" ("Byron Wallet2", m, "Secure Pa33phrase") w ^. walletId `shouldBe` wr ^. walletId - it "BYRON_RESTORE_03 - Cannot restore wallet that exists" $ \ctx -> do - mnemonic <- genMnemonics M12 + it "BYRON_RESTORE_03 - Cannot restore wallet that exists" $ \ctx -> runResourceT $ do + mnemonic <- liftIO $ genMnemonics M12 let payload = Json [json| { "name": "Some Byron Wallet", "mnemonic_sentence": #{mnemonic}, "passphrase": #{fixturePassphrase}, "style": "random" } |] - r1 <- request @ApiByronWallet ctx (Link.postWallet @'Byron) Default payload - expectResponseCode @IO HTTP.status201 r1 + r1 <- postByronWallet ctx payload + expectResponseCode HTTP.status201 r1 - r2 <- request @ApiByronWallet ctx (Link.postWallet @'Byron) Default payload + r2 <- postByronWallet ctx payload verify r2 - [ expectResponseCode @IO HTTP.status409 + [ expectResponseCode HTTP.status409 , expectErrorMessage ("This operation would yield a wallet with the\ \ following id: " ++ T.unpack (getFromResponse walletId r1) ++ " However, I already know of a wallet with this id.") @@ -277,46 +280,45 @@ spec = describe "BYRON_WALLETS" $ do let matrix = [ ( show minLength ++ " char long" , T.pack (replicate minLength 'ź') - , [ expectResponseCode @IO HTTP.status201 ] + , [ expectResponseCode HTTP.status201 ] ) , ( show maxLength ++ " char long" , T.pack (replicate maxLength 'ą') - , [ expectResponseCode @IO HTTP.status201 ] + , [ expectResponseCode HTTP.status201 ] ) , ( "Russian passphrase", russianWalletName - , [ expectResponseCode @IO HTTP.status201 ] + , [ expectResponseCode HTTP.status201 ] ) , ( "Polish passphrase", polishWalletName - , [ expectResponseCode @IO HTTP.status201 ] + , [ expectResponseCode HTTP.status201 ] ) , ( "Kanji passphrase", kanjiWalletName - , [ expectResponseCode @IO HTTP.status201 ] + , [ expectResponseCode HTTP.status201 ] ) , ( "Arabic passphrase", arabicWalletName - , [ expectResponseCode @IO HTTP.status201 ] + , [ expectResponseCode HTTP.status201 ] ) , ( "Wildcards passphrase", wildcardsWalletName - , [ expectResponseCode @IO HTTP.status201 ] + , [ expectResponseCode HTTP.status201 ] ) ] forM_ matrix $ \(title, passphrase, expectations) -> it title $ - \ctx -> do - mnemonics12 <- genMnemonics M12 + \ctx -> runResourceT $ do + mnemonics12 <- liftIO $ genMnemonics M12 let payload = Json [json| { "name": "Secure Wallet", "mnemonic_sentence": #{mnemonics12}, "passphrase": #{passphrase}, "style": "random" } |] - r <- request - @ApiByronWallet ctx (Link.postWallet @'Byron) Default payload + r <- postByronWallet ctx payload verify r expectations it "BYRON_UPDATE_NAME_01 - Update names of wallets" $ \ctx -> forM_ [ (emptyRandomWallet ctx, "Random Wallet") , (emptyIcarusWallet ctx, "Icarus Wallet") ] $ - \(emptyByronWallet, wName) -> do + \(emptyByronWallet, wName) -> runResourceT $ do w <- emptyByronWallet r1 <- request @ApiByronWallet ctx (Link.getWallet @'Byron w) Default Empty @@ -329,14 +331,14 @@ spec = describe "BYRON_WALLETS" $ do r2 <- request @ApiByronWallet ctx (Link.putWallet @'Byron w) Default payload verify r2 - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` updatedName) ] - it "BYRON_UPDATE_NAME_02 - Update names of wallets from Xprv" $ \ctx -> do + it "BYRON_UPDATE_NAME_02 - Update names of wallets from Xprv" $ \ctx -> runResourceT $ do -- Wallet from XPRV let wName = "Byron Wallet from XPRV" - mnemonics <- genMnemonics M12 + mnemonics <- liftIO $ genMnemonics M12 let rootXPrv = rootPrvKeyFromMnemonics mnemonics fixturePassphrase w <- emptyByronWalletFromXPrvWith ctx "random" (wName, rootXPrv, fixturePassphraseEncrypted) @@ -354,21 +356,21 @@ spec = describe "BYRON_WALLETS" $ do r2 <- request @ApiByronWallet ctx (Link.putWallet @'Byron w) Default payload verify r2 - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` updatedName) ] it "BYRON_UTXO_01 - Wallet's inactivity is reflected in utxo" $ \ctx -> - forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> do + forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> runResourceT $ do w <- emptyByronWallet ctx rStat <- request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Byron w) Default Empty - expectResponseCode @IO HTTP.status200 rStat + expectResponseCode HTTP.status200 rStat expectWalletUTxO [] (snd rStat) it "BYRON_UPDATE_PASS_01 - change passphrase" $ \ctx -> - forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> do + forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> runResourceT $ do w <- emptyByronWallet ctx request @ApiByronWallet ctx (Link.getWallet @'Byron w) Default Empty >>= flip verify [ expectField #passphrase (`shouldSatisfy` isJust) ] @@ -377,11 +379,11 @@ spec = describe "BYRON_WALLETS" $ do r <- request @ApiByronWallet ctx (Link.putWalletPassphrase @'Byron w) Default payload verify r - [ expectResponseCode @IO HTTP.status204 + [ expectResponseCode HTTP.status204 ] it "BYRON_UPDATE_PASS_02 - Old passphrase incorrect" $ \ctx -> - forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> do + forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> runResourceT $ do w <- emptyByronWallet ctx request @ApiByronWallet ctx (Link.getWallet @'Byron w) Default Empty >>= flip verify [ expectField #passphrase (`shouldSatisfy` isJust) ] @@ -389,11 +391,11 @@ spec = describe "BYRON_WALLETS" $ do r <- request @ApiByronWallet ctx (Link.putWalletPassphrase @'Byron w) Default payload verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage errMsg403WrongPass ] - it "BYRON_UPDATE_PASS_03 - Updating passphrase with no password wallets" $ \ctx -> do + it "BYRON_UPDATE_PASS_03 - Updating passphrase with no password wallets" $ \ctx -> runResourceT $ do w <- emptyRandomWalletWithPasswd ctx "" request @ApiByronWallet ctx (Link.getWallet @'Byron w) Default Empty >>= flip verify [ expectField #passphrase (`shouldSatisfy` isNothing) ] @@ -401,10 +403,10 @@ spec = describe "BYRON_WALLETS" $ do r <- request @ApiByronWallet ctx (Link.putWalletPassphrase @'Byron w) Default payload verify r - [ expectResponseCode @IO HTTP.status204 + [ expectResponseCode HTTP.status204 ] - it "BYRON_UPDATE_PASS_04a - Updating passphrase with no password wallets" $ \ctx -> do + it "BYRON_UPDATE_PASS_04a - Updating passphrase with no password wallets" $ \ctx -> runResourceT $ do w <- emptyRandomWalletWithPasswd ctx "" request @ApiByronWallet ctx (Link.getWallet @'Byron w) Default Empty >>= flip verify [ expectField #passphrase (`shouldSatisfy` isNothing) ] @@ -412,10 +414,10 @@ spec = describe "BYRON_WALLETS" $ do r <- request @ApiByronWallet ctx (Link.putWalletPassphrase @'Byron w) Default payload verify r - [ expectResponseCode @IO HTTP.status204 + [ expectResponseCode HTTP.status204 ] - it "BYRON_UPDATE_PASS_04b - Regression test" $ \ctx -> do + it "BYRON_UPDATE_PASS_04b - Regression test" $ \ctx -> runResourceT $ do let key = "38e8de9c583441213fe34eecc4e28265267466877ba4048e3ab1fa99563\ \66947aefaf5ba9779db67eead7fc9cd1354b994a5d8d9cd40ab874bfeb1\ \b33649280cd33651377731e0e59e0233425a55257782c5adaa768da0567\ @@ -430,10 +432,10 @@ spec = describe "BYRON_WALLETS" $ do r <- request @ApiByronWallet ctx (Link.putWalletPassphrase @'Byron w) Default payload verify r - [ expectResponseCode @IO HTTP.status204 + [ expectResponseCode HTTP.status204 ] - it "BYRON_UPDATE_PASS_07 - Updating passphrase with short password wallets" $ \ctx -> do + it "BYRON_UPDATE_PASS_07 - Updating passphrase with short password wallets" $ \ctx -> runResourceT $ do w <- emptyRandomWalletWithPasswd ctx "cos" request @ApiByronWallet ctx (Link.getWallet @'Byron w) Default Empty >>= flip verify [ expectField #passphrase (`shouldSatisfy` isJust) ] @@ -441,5 +443,5 @@ spec = describe "BYRON_WALLETS" $ do r <- request @ApiByronWallet ctx (Link.putWalletPassphrase @'Byron w) Default payload verify r - [ expectResponseCode @IO HTTP.status204 + [ expectResponseCode HTTP.status204 ] diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Network.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Network.hs index db3c72acdea..422953a5a75 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Network.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Network.hs @@ -26,6 +26,8 @@ import Control.Monad ( when ) import Control.Monad.IO.Class ( liftIO ) +import Control.Monad.Trans.Resource + ( runResourceT ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.Maybe @@ -76,7 +78,7 @@ spec = describe "COMMON_NETWORK" $ do nextEpochNum `shouldBe` currentEpochNum + 1 it "NETWORK_BYRON - Byron wallet has the same tip as network/information" $ - \ctx -> do + \ctx -> runResourceT @IO $ do let getNetworkInfo = request @ApiNetworkInformation ctx Link.getNetworkInfo Default Empty w <- emptyRandomWallet ctx diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs index 87277a45042..aac3ebbcdd7 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Addresses.hs @@ -28,6 +28,8 @@ import Cardano.Wallet.Primitive.Types ( AddressState (..) ) import Control.Monad ( forM_ ) +import Control.Monad.Trans.Resource + ( runResourceT ) import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.Quantity @@ -71,62 +73,62 @@ spec :: forall n t. , EncodeAddress n ) => SpecWith (Context t) spec = describe "SHELLEY_ADDRESSES" $ do - it "BYRON_ADDRESS_LIST - Byron wallet on Shelley ep" $ \ctx -> do + it "BYRON_ADDRESS_LIST - Byron wallet on Shelley ep" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let wid = w ^. walletId let ep = ("GET", "v2/wallets/" <> wid <> "/addresses") r <- request @[ApiAddress n] ctx ep Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet wid) r - it "ADDRESS_LIST_01 - Can list known addresses on a default wallet" $ \ctx -> do + it "ADDRESS_LIST_01 - Can list known addresses on a default wallet" $ \ctx -> runResourceT $ do let g = fromIntegral $ getAddressPoolGap defaultAddressPoolGap w <- emptyWallet ctx r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r expectListSize g r forM_ [0..(g-1)] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) r - it "ADDRESS_LIST_01 - Can list addresses with non-default pool gap" $ \ctx -> do + it "ADDRESS_LIST_01 - Can list addresses with non-default pool gap" $ \ctx -> runResourceT $ do let g = 15 w <- emptyWalletWith ctx ("Wallet", "cardano-wallet", g) r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r expectListSize g r forM_ [0..(g-1)] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) r - it "ADDRESS_LIST_02 - Can filter used and unused addresses" $ \ctx -> do + it "ADDRESS_LIST_02 - Can filter used and unused addresses" $ \ctx -> runResourceT $ do let g = fromIntegral $ getAddressPoolGap defaultAddressPoolGap w <- fixtureWallet ctx rUsed <- request @[ApiAddress n] ctx (Link.listAddresses' @'Shelley w (Just Used)) Default Empty - expectResponseCode @IO HTTP.status200 rUsed + expectResponseCode HTTP.status200 rUsed expectListSize 10 rUsed forM_ [0..9] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Used) rUsed rUnused <- request @[ApiAddress n] ctx (Link.listAddresses' @'Shelley w (Just Unused)) Default Empty - expectResponseCode @IO HTTP.status200 rUnused + expectResponseCode HTTP.status200 rUnused expectListSize g rUnused forM_ [10..(g-1)] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) rUnused it "ADDRESS_LIST_02 - Shows nothing when there are no used addresses" - $ \ctx -> do + $ \ctx -> runResourceT $ do w <- emptyWallet ctx rUsed <- request @[ApiAddress n] ctx (Link.listAddresses' @'Shelley w (Just Used)) Default Empty rUnused <- request @[ApiAddress n] ctx (Link.listAddresses' @'Shelley w (Just Unused)) Default Empty - expectResponseCode @IO HTTP.status200 rUsed + expectResponseCode HTTP.status200 rUsed expectListSize 0 rUsed - expectResponseCode @IO HTTP.status200 rUnused + expectResponseCode HTTP.status200 rUnused expectListSize 20 rUnused forM_ [0..19] $ \addrNum -> do expectListField @@ -148,19 +150,19 @@ spec = describe "SHELLEY_ADDRESSES" $ do ] let withQuery f (method, link) = (method, link <> "?state=" <> T.pack f) - forM_ filters $ \fil -> it fil $ \ctx -> do + forM_ filters $ \fil -> it fil $ \ctx -> runResourceT $ do w <- emptyWallet ctx let link = withQuery fil $ Link.listAddresses @'Shelley w r <- request @[ApiAddress n] ctx link Default Empty verify r - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage $ "Error parsing query parameter state failed: Unable to\ \ decode the given value: '" <> fil <> "'. Please specify\ \ one of the following values: used, unused." ] - it "ADDRESS_LIST_03 - Generates new address pool gap" $ \ctx -> do + it "ADDRESS_LIST_03 - Generates new address pool gap" $ \ctx -> runResourceT $ do let initPoolGap = 10 wSrc <- fixtureWallet ctx wDest <- emptyWalletWith ctx ("Wallet", "cardano-wallet", initPoolGap) @@ -169,7 +171,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley wDest) Default Empty verify r - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize initPoolGap ] forM_ [0..9] $ \addrNum -> do @@ -192,7 +194,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do rTrans <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload - expectResponseCode @IO HTTP.status202 rTrans + expectResponseCode HTTP.status202 rTrans -- make sure all transactions are in ledger eventually "Wallet balance = initPoolGap * minUTxOValue" $ do @@ -207,7 +209,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do rAddr <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley wDest) Default Empty verify rAddr - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 20 ] forM_ [0..9] $ \addrNum -> do @@ -217,21 +219,21 @@ spec = describe "SHELLEY_ADDRESSES" $ do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) rAddr - it "ADDRESS_LIST_04 - Deleted wallet" $ \ctx -> do + it "ADDRESS_LIST_04 - Deleted wallet" $ \ctx -> runResourceT $ do w <- emptyWallet ctx _ <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r - it "ADDRESS_INSPECT_01 - Address inspect OK" $ \ctx -> do + it "ADDRESS_INSPECT_01 - Address inspect OK" $ \ctx -> runResourceT $ do let str = "Ae2tdPwUPEYz6ExfbWubiXPB6daUuhJxikMEb4eXRp5oKZBKZwrbJ2k7EZe" r <- request @Aeson.Value ctx (Link.inspectAddress str) Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r - it "ADDRESS_INSPECT_02 - Address inspect KO" $ \ctx -> do + it "ADDRESS_INSPECT_02 - Address inspect KO" $ \ctx -> runResourceT $ do let str = "patate" r <- request @Aeson.Value ctx (Link.inspectAddress str) Default Empty - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/HWWallets.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/HWWallets.hs index c0ceff99701..6ff452cea19 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/HWWallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/HWWallets.hs @@ -34,6 +34,10 @@ import Cardano.Wallet.Primitive.Types ( AddressState (..) ) import Control.Monad ( forM_ ) +import Control.Monad.IO.Class + ( liftIO ) +import Control.Monad.Trans.Resource + ( runResourceT ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.List.NonEmpty @@ -65,6 +69,7 @@ import Test.Integration.Framework.DSL , json , listAddresses , minUTxOValue + , postWallet , pubKeyFromMnemonics , request , restoreWalletFromPubKey @@ -85,15 +90,15 @@ spec :: forall n t. , EncodeAddress n ) => SpecWith (Context t) spec = describe "SHELLEY_HW_WALLETS" $ do - it "HW_WALLETS_01 - Restoration from account public key preserves funds" $ \ctx -> do + it "HW_WALLETS_01 - Restoration from account public key preserves funds" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx -- create wallet - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let wName = "!st created" let payldCrt = payloadWith wName mnemonics - rInit <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payldCrt + rInit <- postWallet ctx payldCrt verify rInit - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField (#balance . #getApiT . #available) (`shouldBe` Quantity 0) , expectField (#balance . #getApiT . #total) (`shouldBe` Quantity 0) ] @@ -114,7 +119,7 @@ spec = describe "SHELLEY_HW_WALLETS" $ do }|] rTrans <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload - expectResponseCode @IO HTTP.status202 rTrans + expectResponseCode HTTP.status202 rTrans eventually "Wallet balance is as expected" $ do rGet <- request @ApiWallet ctx @@ -129,7 +134,7 @@ spec = describe "SHELLEY_HW_WALLETS" $ do -- delete wallet rDel <- request @ApiWallet ctx (Link.deleteWallet @'Shelley wDest) Default Empty - expectResponseCode @IO HTTP.status204 rDel + expectResponseCode HTTP.status204 rDel -- restore from account public key and make sure funds are there let accXPub = pubKeyFromMnemonics mnemonics @@ -146,11 +151,11 @@ spec = describe "SHELLEY_HW_WALLETS" $ do ] describe "HW_WALLETS_03 - Cannot do operations requiring private key" $ do - it "Cannot send tx" $ \ctx -> do + it "Cannot send tx" $ \ctx -> runResourceT $ do (w, mnemonics) <- fixtureWalletWithMnemonics ctx let pubKey = pubKeyFromMnemonics mnemonics r <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status204 r + expectResponseCode HTTP.status204 r wSrc <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName wDest <- emptyWallet ctx @@ -169,11 +174,11 @@ spec = describe "SHELLEY_HW_WALLETS" $ do }|] rTrans <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload - expectResponseCode @IO HTTP.status403 rTrans + expectResponseCode HTTP.status403 rTrans expectErrorMessage (errMsg403NoRootKey $ wSrc ^. walletId) rTrans - it "Cannot update pass" $ \ctx -> do - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + it "Cannot update pass" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wk <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName @@ -181,12 +186,12 @@ spec = describe "SHELLEY_HW_WALLETS" $ do let payload = updatePassPayload fixturePassphrase "new-wallet-passphrase" rup <- request @ApiWallet ctx (Link.putWalletPassphrase @'Shelley wk) Default payload - expectResponseCode @IO HTTP.status403 rup + expectResponseCode HTTP.status403 rup expectErrorMessage (errMsg403NoRootKey $ wk ^. walletId) rup describe "HW_WALLETS_04 - Can manage HW wallet the same way as others" $ do - it "Can update name" $ \ctx -> do - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + it "Can update name" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wk <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName @@ -194,7 +199,7 @@ spec = describe "SHELLEY_HW_WALLETS" $ do let newName = "new name" let payload = updateNamePayload newName rup <- request @ApiWallet ctx (Link.putWallet @'Shelley wk) Default payload - expectResponseCode @IO HTTP.status200 rup + expectResponseCode HTTP.status200 rup rGet <- request @ApiWallet ctx (Link.getWallet @'Shelley wk) Default Empty @@ -203,11 +208,11 @@ spec = describe "SHELLEY_HW_WALLETS" $ do (`shouldBe` newName) rGet - it "Can get tx fee" $ \ctx -> do + it "Can get tx fee" $ \ctx -> runResourceT $ do (w, mnemonics) <- fixtureWalletWithMnemonics ctx let pubKey = pubKeyFromMnemonics mnemonics r <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status204 r + expectResponseCode HTTP.status204 r wSrc <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName wDest <- emptyWallet ctx @@ -226,40 +231,40 @@ spec = describe "SHELLEY_HW_WALLETS" $ do rFee <- request @ApiFee ctx (Link.getTransactionFee @'Shelley wSrc) Default payload - expectResponseCode @IO HTTP.status202 rFee + expectResponseCode HTTP.status202 rFee - it "Can delete" $ \ctx -> do - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + it "Can delete" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wPub <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName r <- request @ApiWallet ctx (Link.deleteWallet @'Shelley wPub) Default Empty - expectResponseCode @IO HTTP.status204 r + expectResponseCode HTTP.status204 r - it "Can see utxo" $ \ctx -> do - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + it "Can see utxo" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wPub <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName rStat <- request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Shelley wPub) Default Empty - expectResponseCode @IO HTTP.status200 rStat + expectResponseCode HTTP.status200 rStat expectWalletUTxO [] (snd rStat) - it "Can list addresses" $ \ctx -> do - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + it "Can list addresses" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wPub <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName let g = fromIntegral $ getAddressPoolGap defaultAddressPoolGap r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley wPub) Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r expectListSize g r forM_ [0..(g-1)] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) r - it "Can have address pool gap" $ \ctx -> do - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + it "Can have address pool gap" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics let addrPoolGap = 55 --arbitraty but known let payloadRestore = Json [json| { @@ -267,21 +272,20 @@ spec = describe "SHELLEY_HW_WALLETS" $ do "account_public_key": #{pubKey}, "address_pool_gap": #{addrPoolGap} }|] - rRestore <- request @ApiWallet ctx (Link.postWallet @'Shelley) - Default payloadRestore - expectResponseCode @IO HTTP.status201 rRestore + rRestore <- postWallet ctx payloadRestore + expectResponseCode HTTP.status201 rRestore let wPub = getFromResponse id rRestore r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley wPub) Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r expectListSize addrPoolGap r forM_ [0..(addrPoolGap-1)] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) r - it "Can list transactions" $ \ctx -> do - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + it "Can list transactions" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wPub <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName @@ -290,11 +294,11 @@ spec = describe "SHELLEY_HW_WALLETS" $ do expectResponseCode HTTP.status200 rt expectListSize 0 rt - it "Can get coin selection" $ \ctx -> do + it "Can get coin selection" $ \ctx -> runResourceT $ do (w, mnemonics) <- fixtureWalletWithMnemonics ctx let pubKey = pubKeyFromMnemonics mnemonics r <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status204 r + expectResponseCode HTTP.status204 r source <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName target <- emptyWallet ctx @@ -302,7 +306,7 @@ spec = describe "SHELLEY_HW_WALLETS" $ do let amount = Quantity minUTxOValue let payment = AddressAmount targetAddress amount - selectCoins @n @'Shelley ctx source (payment :| []) >>= flip verify + liftIO $ selectCoins @n @'Shelley ctx source (payment :| []) >>= flip verify [ expectResponseCode HTTP.status200 , expectField #inputs (`shouldSatisfy` (not . null)) , expectField #outputs (`shouldSatisfy` ((> 1) . length)) @@ -310,8 +314,8 @@ spec = describe "SHELLEY_HW_WALLETS" $ do ] describe "HW_WALLETS_05 - Wallet from pubKey is available" $ do - it "Can get wallet" $ \ctx -> do - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + it "Can get wallet" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics wPub <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName rGet <- request @ApiWallet ctx @@ -321,8 +325,8 @@ spec = describe "SHELLEY_HW_WALLETS" $ do (`shouldBe` restoredWalletName) rGet - it "Can list wallet" $ \ctx -> do - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + it "Can list wallet" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let pubKey = pubKeyFromMnemonics mnemonics _ <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey restoredWalletName rl <- request @[ApiWallet] ctx @@ -332,27 +336,29 @@ spec = describe "SHELLEY_HW_WALLETS" $ do (`shouldBe` restoredWalletName) rl - it "The same account and mnemonic wallet can live side-by-side" $ \ctx -> do - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + it "The same account and mnemonic wallet can live side-by-side" $ \ctx -> runResourceT $ do + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy -- create mnemonic wallet let mnemonicWalletName = "Mnemonic wallet" let payldCrt = payloadWith mnemonicWalletName mnemonics - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payldCrt - expectResponseCode @IO HTTP.status201 r + r1' <- postWallet ctx payldCrt + expectResponseCode HTTP.status201 r1' -- create from account public key let accXPub = pubKeyFromMnemonics mnemonics - _ <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx accXPub restoredWalletName + r2' <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx accXPub restoredWalletName + + r1 <- request @ApiWallet ctx (Link.getWallet @'Shelley (getFromResponse id r1')) Default Empty + r2 <- request @ApiWallet ctx (Link.getWallet @'Shelley r2') Default Empty -- both wallets are available - rl <- request @[ApiWallet] ctx - (Link.listWallets @'Shelley) Default Empty - verify rl - [ expectListField 0 - (#name . #getApiT . #getWalletName) + liftIO $ verify r1 + [ expectField (#name . #getApiT . #getWalletName) (`shouldBe` mnemonicWalletName) - , expectListField 1 + ] + liftIO $ verify r2 + [ expectField (#name . #getApiT . #getWalletName) (`shouldBe` restoredWalletName) ] diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs index c55d337de30..efd1fd101e3 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Migrations.hs @@ -38,6 +38,10 @@ import Cardano.Wallet.Primitive.AddressDerivation.Shelley ( ShelleyKey ) import Control.Monad ( forM_ ) +import Control.Monad.IO.Class + ( liftIO ) +import Control.Monad.Trans.Resource + ( runResourceT ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.Maybe @@ -69,9 +73,10 @@ import Test.Integration.Framework.DSL , icarusAddresses , json , listAddresses + , postWallet , randomAddresses , request - , unsafeRequest + , unsafeResponse , verify , walletId , (.>) @@ -100,24 +105,24 @@ spec :: forall n t. spec = describe "SHELLEY_MIGRATIONS" $ do it "SHELLEY_CALCULATE_01 - \ \for non-empty wallet calculated fee is > zero." - $ \ctx -> do + $ \ctx -> runResourceT $ do w <- fixtureWallet ctx let ep = Link.getMigrationInfo @'Shelley w r <- request @ApiWalletMigrationInfo ctx ep Default Empty verify r - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField (#migrationCost . #getQuantity) (.> 0) ] it "SHELLEY_CALCULATE_02 - \ \Cannot calculate fee for empty wallet." - $ \ctx -> do + $ \ctx -> runResourceT $ do w <- emptyWallet ctx let ep = Link.getMigrationInfo @'Shelley w r <- request @ApiWalletMigrationInfo ctx ep Default Empty verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage (errMsg403NothingToMigrate $ w ^. walletId) ] @@ -128,11 +133,11 @@ spec = describe "SHELLEY_MIGRATIONS" $ do ] $ \(walType, byronWallet) -> do it ("Cannot calculate Shelley migration using wallet: " ++ walType) - $ \ctx -> do + $ \ctx -> runResourceT $ do w <- byronWallet ctx let ep = Link.getMigrationInfo @'Shelley w r <- request @ApiWalletMigrationInfo ctx ep Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r describe "SHELLEY_MIGRATE_01 - \ @@ -145,7 +150,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do testAddressCycling 10 Hspec.it "SHELLEY_MIGRATE_01_big_wallet - \ - \ migrate a big wallet requiring more than one tx" $ \ctx -> do + \ migrate a big wallet requiring more than one tx" $ \ctx -> runResourceT @IO $ do -- NOTE -- Special mnemonic for which 200 shelley funds are attached to in the @@ -163,8 +168,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do "mnemonic_sentence": #{mnemonics}, "passphrase": #{fixturePassphrase} } |] - (_, wOld) <- unsafeRequest @ApiWallet ctx - (Link.postWallet @'Shelley) payloadRestore + wOld <- unsafeResponse <$> postWallet ctx payloadRestore originalBalance <- eventually "wallet balance greater than 0" $ do r <- request @ApiWallet ctx (Link.getWallet @'Shelley wOld) @@ -182,7 +186,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do Default Empty verify rFee - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField #migrationCost (.> Quantity 0) ] let expectedFee = getFromResponse (#migrationCost . #getQuantity) rFee @@ -202,7 +206,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do (Link.migrateWallet @'Shelley wOld) Default payloadMigrate >>= flip verify - [ expectResponseCode @IO HTTP.status202 + [ expectResponseCode HTTP.status202 , expectField id ((`shouldBe` 15) . length) ] @@ -232,7 +236,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do it "SHELLEY_MIGRATE_02 - \ \migrating an empty wallet should fail." - $ \ctx -> do + $ \ctx -> runResourceT $ do sourceWallet <- emptyWallet ctx targetWallet <- emptyWallet ctx addrs <- listAddresses @n ctx targetWallet @@ -246,13 +250,13 @@ spec = describe "SHELLEY_MIGRATIONS" $ do r <- request @[ApiTransaction n] ctx ep Default payload let srcId = sourceWallet ^. walletId verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage (errMsg403NothingToMigrate srcId) ] Hspec.it "SHELLEY_MIGRATE_02 - \ \migrating wallet with 'dust' (that complies with minUTxOValue) should pass." - $ \ctx -> do + $ \ctx -> runResourceT @IO $ do -- NOTE -- Special mnemonic for which wallet has dust -- (10 utxo with 43 ADA) @@ -265,8 +269,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do "mnemonic_sentence": #{mnemonics}, "passphrase": #{fixturePassphrase} } |] - (_, sourceWallet) <- unsafeRequest @ApiWallet ctx - (Link.postWallet @'Shelley) payloadRestore + sourceWallet <- unsafeResponse <$> postWallet ctx payloadRestore originalBalance <- eventually "wallet balance greater than 0" $ do rg <- request @ApiWallet ctx (Link.getWallet @'Shelley sourceWallet) @@ -282,7 +285,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do r0 <- request @ApiWalletMigrationInfo ctx (Link.getMigrationInfo @'Shelley sourceWallet) Default Empty verify r0 - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField #migrationCost (.> Quantity 0) ] let expectedFee = getFromResponse (#migrationCost . #getQuantity) r0 @@ -298,7 +301,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do let ep = Link.migrateWallet @'Shelley sourceWallet r <- request @[ApiTransaction n] ctx ep Default payload verify r - [ expectResponseCode @IO HTTP.status202 ] + [ expectResponseCode HTTP.status202 ] -- Check that funds become available in the target wallet: let expectedBalance = originalBalance - expectedFee @@ -317,7 +320,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do it "SHELLEY_MIGRATE_03 - \ \actual fee for migration is the same as the predicted fee." - $ \ctx -> do + $ \ctx -> runResourceT $ do -- Restore a Shelley wallet with funds. sourceWallet <- fixtureWallet ctx @@ -325,7 +328,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do let ep0 = (Link.getMigrationInfo @'Shelley sourceWallet) r0 <- request @ApiWalletMigrationInfo ctx ep0 Default Empty verify r0 - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField #migrationCost (.> Quantity 0) ] @@ -341,7 +344,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do let ep1 = Link.migrateWallet @'Shelley sourceWallet r1 <- request @[ApiTransaction n] ctx ep1 Default payload verify r1 - [ expectResponseCode @IO HTTP.status202 + [ expectResponseCode HTTP.status202 , expectField id (`shouldSatisfy` (not . null)) ] @@ -350,9 +353,9 @@ spec = describe "SHELLEY_MIGRATIONS" $ do <$> getFromResponse id r1 let predictedFee = getFromResponse (#migrationCost . #getQuantity) r0 - actualFee `shouldBe` predictedFee + liftIO $ actualFee `shouldBe` predictedFee - it "SHELLEY_MIGRATE_04 - migration fails with a wrong passphrase" $ \ctx -> do + it "SHELLEY_MIGRATE_04 - migration fails with a wrong passphrase" $ \ctx -> runResourceT $ do -- Restore a Shelley wallet with funds, to act as a source wallet: sourceWallet <- fixtureWallet ctx @@ -368,21 +371,21 @@ spec = describe "SHELLEY_MIGRATIONS" $ do , addresses: [#{addr1}] }|]) verify r0 - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage errMsg403WrongPass ] - it "SHELLEY_MIGRATE_05 - I could migrate to any valid address" $ \ctx -> do + it "SHELLEY_MIGRATE_05 - I could migrate to any valid address" $ \ctx -> runResourceT $ do --shelley address wShelley <- emptyWallet ctx addrs <- listAddresses @n ctx wShelley let addrShelley = (addrs !! 1) ^. #id --icarus address - addrIcarus <- encodeAddress @n . head . icarusAddresses @n + addrIcarus <- liftIO $ encodeAddress @n . head . icarusAddresses @n . entropyToMnemonic @15 <$> genEntropy --byron address - addrByron <- encodeAddress @n . head . randomAddresses @n + addrByron <- liftIO $ encodeAddress @n . head . randomAddresses @n . entropyToMnemonic @12 <$> genEntropy sWallet <- emptyWallet ctx @@ -394,18 +397,18 @@ spec = describe "SHELLEY_MIGRATIONS" $ do , addresses: [#{addrShelley}, #{addrIcarus}, #{addrByron}] }|]) verify r - [ expectResponseCode @IO HTTP.status403 + [ expectResponseCode HTTP.status403 , expectErrorMessage (errMsg403NothingToMigrate (sWallet ^. walletId)) ] - it "SHELLEY_MIGRATE_07 - invalid payload, parser error" $ \ctx -> do + it "SHELLEY_MIGRATE_07 - invalid payload, parser error" $ \ctx -> runResourceT $ do sourceWallet <- emptyWallet ctx r <- request @[ApiTransaction n] ctx (Link.migrateWallet @'Shelley sourceWallet) Default (NonJson "{passphrase:,}") - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r expectErrorMessage errMsg400ParseError r where -- Compute the fee associated with an API transaction. @@ -425,7 +428,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do testAddressCycling addrNum = it ("Migration from Shelley wallet to " ++ show addrNum ++ " addresses") - $ \ctx -> do + $ \ctx -> runResourceT $ do -- Restore a Shelley wallet with funds, to act as a source wallet: sourceWallet <- fixtureWallet ctx let originalBalance = @@ -443,7 +446,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do r0 <- request @ApiWalletMigrationInfo ctx (Link.getMigrationInfo @'Shelley sourceWallet) Default Empty verify r0 - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField #migrationCost (.> Quantity 0) ] let expectedFee = getFromResponse (#migrationCost . #getQuantity) r0 @@ -457,7 +460,7 @@ spec = describe "SHELLEY_MIGRATIONS" $ do , addresses: #{addrIds} }|]) verify r1 - [ expectResponseCode @IO HTTP.status202 + [ expectResponseCode HTTP.status202 , expectField id (`shouldSatisfy` (not . null)) ] diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs index e2690ea71fd..61c4d67fc03 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/StakePools.hs @@ -45,6 +45,10 @@ import Cardano.Wallet.Unsafe ( unsafeFromHex, unsafeMkPercentage ) import Control.Monad ( forM_ ) +import Control.Monad.IO.Class + ( liftIO ) +import Control.Monad.Trans.Resource + ( runResourceT ) import Data.Function ( (&) ) import Data.Generics.Internal.VL.Lens @@ -95,9 +99,11 @@ import Test.Integration.Framework.DSL , listAddresses , minUTxOValue , notDelegating + , postWallet , quitStakePool , request , unsafeRequest + , unsafeResponse , verify , waitForNextEpoch , walletId @@ -125,10 +131,10 @@ spec :: forall n t. , PaymentAddress n ShelleyKey ) => SpecWith (Context t) spec = describe "SHELLEY_STAKE_POOLS" $ do - let listPools ctx stake = request @[ApiStakePool] @IO ctx + let listPools ctx stake = request @[ApiStakePool] ctx (Link.listStakePools stake) Default Empty - it "STAKE_POOLS_JOIN_01 - Cannot join non-existent wallet" $ \ctx -> do + it "STAKE_POOLS_JOIN_01 - Cannot join non-existent wallet" $ \ctx -> runResourceT $ do w <- emptyWallet ctx let wid = w ^. walletId _ <- request @ApiWallet ctx @@ -138,7 +144,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet wid) r - it "STAKE_POOLS_JOIN_01 - Cannot join non-existent stakepool" $ \ctx -> do + it "STAKE_POOLS_JOIN_01 - Cannot join non-existent stakepool" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx let poolIdAbsent = PoolId $ BS.pack $ replicate 32 1 r <- joinStakePool @n ctx (ApiT poolIdAbsent) (w, fixturePassphrase) @@ -146,7 +152,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do expectErrorMessage (errMsg404NoSuchPool (toText poolIdAbsent)) r it "STAKE_POOLS_JOIN_01 - \ - \Cannot join existent stakepool with wrong password" $ \ctx -> do + \Cannot join existent stakepool with wrong password" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx pool:_ <- map (view #id) . snd <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty @@ -156,7 +162,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do ] it "STAKE_POOLS_JOIN_01rewards - \ - \Can join a pool, earn rewards and collect them" $ \ctx -> do + \Can join a pool, earn rewards and collect them" $ \ctx -> runResourceT $ do -- Setup src <- fixtureWallet ctx dest <- emptyWallet ctx @@ -174,7 +180,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do waitForNextEpoch ctx waitForNextEpoch ctx (previousBalance, walletRewards) <- - eventually "Wallet gets rewards" $ do + liftIO $ eventually "Wallet gets rewards" $ do r <- request @ApiWallet ctx (Link.getWallet @'Shelley src) Default Empty verify r @@ -337,7 +343,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do ] it "STAKE_POOLS_JOIN_02 - \ - \Cannot join already joined stake pool" $ \ctx -> do + \Cannot join already joined stake pool" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx pool:_ <- map (view #id) . snd <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty @@ -362,7 +368,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do (errMsg403PoolAlreadyJoined $ toText $ getApiT pool) ] - it "STAKE_POOLS_JOIN_03 - Cannot join a pool that has retired" $ \ctx -> do + it "STAKE_POOLS_JOIN_03 - Cannot join a pool that has retired" $ \ctx -> runResourceT $ do nonRetiredPoolIds <- eventually "One of the pools should retire." $ do response <- listPools ctx arbitraryStake verify response [ expectListSize 3 ] @@ -386,7 +392,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoSuchPool (toText retiredPoolId)) r - it "STAKE_POOLS_QUIT_02 - Passphrase must be correct to quit" $ \ctx -> do + it "STAKE_POOLS_QUIT_02 - Passphrase must be correct to quit" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx pool:_ <- map (view #id) . snd <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty @@ -413,14 +419,14 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do it "STAKE_POOL_NEXT_02/STAKE_POOLS_QUIT_01 - \ \Cannot quit when active: not_delegating" - $ \ctx -> do + $ \ctx -> runResourceT $ do w <- fixtureWallet ctx quitStakePool @n ctx (w, fixturePassphrase) >>= flip verify [ expectResponseCode HTTP.status403 , expectErrorMessage errMsg403NotDelegating ] - it "STAKE_POOLS_JOIN_01 - Can rejoin another stakepool" $ \ctx -> do + it "STAKE_POOLS_JOIN_01 - Can rejoin another stakepool" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx -- make sure we are at the beginning of new epoch @@ -491,7 +497,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do [ expectField #delegation (`shouldBe` delegating pool2 []) ] - it "STAKE_POOLS_JOIN_04 - Rewards accumulate" $ \ctx -> do + it "STAKE_POOLS_JOIN_04 - Rewards accumulate" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx pool:_ <- map (view #id) . snd <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty @@ -528,7 +534,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do ] it "STAKE_POOLS_JOIN_05 - \ - \Can join when stake key already exists" $ \ctx -> do + \Can join when stake key already exists" $ \ctx -> runResourceT $ do let walletWithPreRegKey = [ "over", "decorate", "flock", "badge", "beauty" , "stamp" , "chest", "owner", "excess", "omit" @@ -540,8 +546,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do "passphrase": #{fixturePassphrase} } |] - (_, w) <- unsafeRequest @ApiWallet ctx - (Link.postWallet @'Shelley) payload + w <- unsafeResponse <$> postWallet ctx payload pool:_ <- map (view #id) . snd <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty @@ -554,7 +559,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do describe "STAKE_POOLS_JOIN_01x - Fee boundary values" $ do it "STAKE_POOLS_JOIN_01x - \ - \I can join if I have just the right amount" $ \ctx -> do + \I can join if I have just the right amount" $ \ctx -> runResourceT $ do w <- fixtureWalletWith @n ctx [costOfJoining ctx + depositAmt ctx] pool:_ <- map (view #id) . snd <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty @@ -565,7 +570,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do ] it "STAKE_POOLS_JOIN_01x - \ - \I cannot join if I have not enough fee to cover" $ \ctx -> do + \I cannot join if I have not enough fee to cover" $ \ctx -> runResourceT $ do w <- fixtureWalletWith @n ctx [costOfJoining ctx + depositAmt ctx - 1] pool:_ <- map (view #id) . snd <$> unsafeRequest @[ApiStakePool] ctx (Link.listStakePools arbitraryStake) Empty @@ -577,7 +582,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do describe "STAKE_POOLS_QUIT_01x - Fee boundary values" $ do it "STAKE_POOLS_QUIT_01xx - \ - \I can quit if I have enough to cover fee" $ \ctx -> do + \I can quit if I have enough to cover fee" $ \ctx -> runResourceT $ do -- change needed to satisfy minUTxOValue let change = minUTxOValue - costOfQuitting ctx let initBalance = @@ -621,7 +626,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do ] it "STAKE_POOLS_QUIT_01x - \ - \I cannot quit if I have not enough to cover fees" $ \ctx -> do + \I cannot quit if I have not enough to cover fees" $ \ctx -> runResourceT $ do let initBalance = [ costOfJoining ctx + depositAmt ctx ] w <- fixtureWalletWith @n ctx initBalance @@ -646,7 +651,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do ] it "STAKE_POOLS_ESTIMATE_FEE_02 - \ - \empty wallet cannot estimate fee" $ \ctx -> do + \empty wallet cannot estimate fee" $ \ctx -> runResourceT $ do w <- emptyWallet ctx delegationFee ctx w >>= flip verify [ expectResponseCode HTTP.status403 @@ -656,7 +661,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do describe "STAKE_POOLS_LIST_01 - List stake pools" $ do - it "has non-zero saturation & stake" $ \ctx -> do + it "has non-zero saturation & stake" $ \ctx -> runResourceT $ do eventually "list pools returns non-empty list" $ do r <- listPools ctx arbitraryStake expectResponseCode HTTP.status200 r @@ -676,7 +681,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do (.> Quantity (unsafeMkPercentage 0)) ] - it "pools have the correct retirement information" $ \ctx -> do + it "pools have the correct retirement information" $ \ctx -> runResourceT $ do let expectedRetirementEpochs = Set.fromList [ Nothing @@ -700,7 +705,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do & Set.fromList actualRetirementEpochs `shouldBe` expectedRetirementEpochs - it "eventually has correct margin, cost and pledge" $ \ctx -> do + it "eventually has correct margin, cost and pledge" $ \ctx -> runResourceT $ do eventually "pool worker finds the certificate" $ do r <- listPools ctx arbitraryStake expectResponseCode HTTP.status200 r @@ -723,7 +728,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do , Quantity $ 2 * oneMillionAda ] - it "at least one pool eventually produces block" $ \ctx -> do + it "at least one pool eventually produces block" $ \ctx -> runResourceT $ do eventually "eventually produces block" $ do (_, Right r) <- listPools ctx arbitraryStake let production = sum $ @@ -734,7 +739,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do production `shouldSatisfy` (> 0) saturation `shouldSatisfy` (any (> 0)) - it "contains pool metadata" $ \ctx -> do + it "contains pool metadata" $ \ctx -> runResourceT $ do eventually "metadata is fetched" $ do r <- listPools ctx arbitraryStake let metadataPossible = Set.fromList @@ -773,7 +778,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do `shouldSatisfy` (`Set.isSubsetOf` metadataPossible) ] - it "contains and is sorted by non-myopic-rewards" $ \ctx -> do + it "contains and is sorted by non-myopic-rewards" $ \ctx -> runResourceT $ do eventually "eventually shows non-zero rewards" $ do Right pools@[pool1,_pool2,pool3] <- snd <$> listPools ctx arbitraryStake @@ -784,7 +789,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do -- Make sure the rewards are not all equal: rewards pool1 .> rewards pool3 - it "non-myopic-rewards are based on stake" $ \ctx -> do + it "non-myopic-rewards are based on stake" $ \ctx -> runResourceT $ do eventually "rewards are smaller for smaller stakes" $ do let stakeSmall = Just (Coin 1_000) let stakeBig = Just (Coin 10_000_000_000_000_000) @@ -797,16 +802,16 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do rewardsStakeBig .> rewardsStakeSmall - it "STAKE_POOLS_LIST_05 - Fails without query parameter" $ \ctx -> do - r <- request @[ApiStakePool] @IO ctx + it "STAKE_POOLS_LIST_05 - Fails without query parameter" $ \ctx -> runResourceT $ do + r <- request @[ApiStakePool] ctx (Link.listStakePools Nothing) Default Empty expectResponseCode HTTP.status400 r it "STAKE_POOLS_LIST_06 - \ - \NonMyopicMemberRewards are 0 when stake is 0" $ \ctx -> do - pendingWith "This assumption seems false, for some reasons..." + \NonMyopicMemberRewards are 0 when stake is 0" $ \ctx -> runResourceT $ do + liftIO $ pendingWith "This assumption seems false, for some reasons..." let stake = Just $ Coin 0 - r <- request @[ApiStakePool] @IO ctx (Link.listStakePools stake) + r <- request @[ApiStakePool] ctx (Link.listStakePools stake) Default Empty expectResponseCode HTTP.status200 r verify r @@ -821,7 +826,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do it "STAKE_POOLS_GARBAGE_COLLECTION_01 - \ \retired pools are garbage collected on schedule and not before" $ - \ctx -> do + \ctx -> runResourceT $ do -- The retirement epoch of the only test pool that is configured -- to retire within the lifetime of an integration test run. @@ -853,7 +858,7 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do -- If this test case is run in isolation, this initial stage will -- require a few minutes to complete. -- - forM_ [1 .. lastGarbageCollectionEpoch] $ \epochNo -> do + liftIO $ forM_ [1 .. lastGarbageCollectionEpoch] $ \epochNo -> do let stateDescription = mconcat [ "Garbage has been collected for epoch " , show epochNo @@ -867,26 +872,27 @@ spec = describe "SHELLEY_STAKE_POOLS" $ do length events `shouldSatisfy` (>= epochNo) -- Check that exactly one pool was garbage collected, and no more: - events <- readIORef (view #_poolGarbageCollectionEvents ctx) + events <- liftIO $ readIORef (view #_poolGarbageCollectionEvents ctx) let certificates = poolGarbageCollectionCertificates =<< events - certificates `shouldSatisfy` ((== 1) . length) + liftIO $ certificates `shouldSatisfy` ((== 1) . length) let [certificate] = certificates let [event] = events & filter (not . null . poolGarbageCollectionCertificates) -- Check that the removed pool was removed at the correct epoch: - view #retirementEpoch certificate - `shouldBe` testPoolRetirementEpoch - poolGarbageCollectionEpochNo event - `shouldBe` testPoolRetirementEpoch - - -- Check that the removed pool was one of the test pools: - view #poolId certificate - `shouldSatisfy` (`Set.member` testClusterPoolIds) - - -- Check that garbage collection occurred exactly once per epoch: - let epochs = poolGarbageCollectionEpochNo <$> events - (reverse epochs `zip` [1 ..]) `shouldSatisfy` all (uncurry (==)) + liftIO $ do + view #retirementEpoch certificate + `shouldBe` testPoolRetirementEpoch + poolGarbageCollectionEpochNo event + `shouldBe` testPoolRetirementEpoch + + -- Check that the removed pool was one of the test pools: + view #poolId certificate + `shouldSatisfy` (`Set.member` testClusterPoolIds) + + -- Check that garbage collection occurred exactly once per epoch: + let epochs = poolGarbageCollectionEpochNo <$> events + (reverse epochs `zip` [1 ..]) `shouldSatisfy` all (uncurry (==)) where arbitraryStake :: Maybe Coin diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs index dcac5669b70..a8cc9c93e92 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Transactions.hs @@ -51,6 +51,12 @@ import Cardano.Wallet.Primitive.Types ) import Control.Monad ( forM_ ) +import Control.Monad.Catch + ( MonadCatch ) +import Control.Monad.IO.Class + ( MonadIO, liftIO ) +import Control.Monad.Trans.Resource + ( ResourceT, runResourceT ) import Data.Aeson ( (.=) ) import Data.ByteArray.Encoding @@ -118,6 +124,7 @@ import Test.Integration.Framework.DSL , listAllTransactions , listTransactions , minUTxOValue + , postWallet , request , rewardWallet , toQueryString @@ -177,7 +184,7 @@ spec :: forall n t. , PaymentAddress n IcarusKey ) => SpecWith (Context t) spec = describe "SHELLEY_TRANSACTIONS" $ do - it "TRANS_MIN_UTXO_01 - I cannot spend less than minUTxOValue" $ \ctx -> do + it "TRANS_MIN_UTXO_01 - I cannot spend less than minUTxOValue" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx @@ -202,10 +209,10 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do it "Regression #1004 -\ \ Transaction to self shows only fees as a tx amount\ - \ while both, pending and in_ledger" $ \ctx -> do + \ while both, pending and in_ledger" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx - payload <- mkTxPayload ctx wSrc minUTxOValue fixturePassphrase + payload <- liftIO $ mkTxPayload ctx wSrc minUTxOValue fixturePassphrase (_, ApiFee (Quantity feeMin) (Quantity feeMax)) <- unsafeRequest ctx (Link.getTransactionFee @'Shelley wSrc) payload @@ -237,7 +244,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do ] it "Regression #935 -\ - \ Pending tx should have pendingSince in the list tx response" $ \ctx -> do + \ Pending tx should have pendingSince in the list tx response" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx @@ -269,11 +276,11 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do insertedAt tx' `shouldBe` Nothing pendingSince tx' `shouldBe` pendingSince tx - it "TRANS_CREATE_01 - Single Output Transaction" $ \ctx -> do + it "TRANS_CREATE_01 - Single Output Transaction" $ \ctx -> runResourceT $ do (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx let amt = (minUTxOValue :: Natural) - payload <- mkTxPayload ctx wb amt fixturePassphrase + payload <- liftIO $ mkTxPayload ctx wb amt fixturePassphrase (_, ApiFee (Quantity feeMin) (Quantity feeMax)) <- unsafeRequest ctx (Link.getTransactionFee @'Shelley wa) payload @@ -317,7 +324,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (#balance . #getApiT . #available) (`shouldBe` Quantity (faucetAmt - feeMax - amt)) ra2 - it "TRANS_CREATE_02 - Multiple Output Tx to single wallet" $ \ctx -> do + it "TRANS_CREATE_02 - Multiple Output Tx to single wallet" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx addrs <- listAddresses @n ctx wDest @@ -379,11 +386,11 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (`shouldBe` Quantity (2*amt)) ] - it "TRANS_CREATE_03 - 0 balance after transaction" $ \ctx -> do + it "TRANS_CREATE_03 - 0 balance after transaction" $ \ctx -> runResourceT $ do let amt = minUTxOValue wDest <- fixtureWalletWith @n ctx [amt] - payload <- mkTxPayload ctx wDest amt fixturePassphrase + payload <- liftIO $ mkTxPayload ctx wDest amt fixturePassphrase (_, ApiFee (Quantity feeMin) _) <- unsafeRequest ctx (Link.getTransactionFee @'Shelley wDest) payload @@ -432,10 +439,10 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectField (#balance . #getApiT . #available) (`shouldBe` Quantity 0) ] - it "TRANS_CREATE_04 - Can't cover fee" $ \ctx -> do + it "TRANS_CREATE_04 - Can't cover fee" $ \ctx -> runResourceT $ do wDest <- fixtureWallet ctx - payload <- mkTxPayload ctx wDest minUTxOValue fixturePassphrase + payload <- liftIO $ mkTxPayload ctx wDest minUTxOValue fixturePassphrase (_, ApiFee (Quantity feeMin) _) <- unsafeRequest ctx (Link.getTransactionFee @'Shelley wDest) payload @@ -448,7 +455,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectErrorMessage errMsg403Fee ] - it "TRANS_CREATE_04 - Not enough money" $ \ctx -> do + it "TRANS_CREATE_04 - Not enough money" $ \ctx -> runResourceT $ do let (srcAmt, reqAmt) = (minUTxOValue, 2 * minUTxOValue) wSrc <- fixtureWalletWith @n ctx [srcAmt] wDest <- emptyWallet ctx @@ -460,7 +467,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectErrorMessage $ errMsg403NotEnoughMoney srcAmt reqAmt ] - it "TRANS_CREATE_04 - Wrong password" $ \ctx -> do + it "TRANS_CREATE_04 - Wrong password" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx addr:_ <- listAddresses @n ctx wDest @@ -483,7 +490,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectErrorMessage errMsg403WrongPass ] - it "TRANS_CREATE_07 - Deleted wallet" $ \ctx -> do + it "TRANS_CREATE_07 - Deleted wallet" $ \ctx -> runResourceT $ do w <- emptyWallet ctx _ <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty wDest <- emptyWallet ctx @@ -501,7 +508,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do }|] r <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley w) Default payload - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r describe "TRANS_CREATE_08 - Bad payload" $ do @@ -519,16 +526,16 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do ) ] - forM_ matrix $ \(name, nonJson) -> it name $ \ctx -> do + forM_ matrix $ \(name, nonJson) -> it name $ \ctx -> runResourceT $ do w <- emptyWallet ctx let payload = nonJson r <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley w) Default payload - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r describe "TRANS_CREATE_09 - Single Output Transaction with non-Shelley witnesses" $ forM_ [(fixtureRandomWallet, "Byron wallet"), (fixtureIcarusWallet, "Icarus wallet")] $ - \(srcFixture,name) -> it name $ \ctx -> do + \(srcFixture,name) -> it name $ \ctx -> runResourceT $ do (wByron, wShelley) <- (,) <$> srcFixture ctx <*> fixtureWallet ctx addrs <- listAddresses @n ctx wShelley @@ -593,7 +600,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (#balance . #available) (`shouldBe` Quantity (faucetAmt - feeEstMax - amt)) ra2 - it "TRANSMETA_CREATE_01 - Transaction with metadata" $ \ctx -> do + it "TRANSMETA_CREATE_01 - Transaction with metadata" $ \ctx -> runResourceT $ do (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx let amt = (minUTxOValue :: Natural) @@ -664,7 +671,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (`shouldBe` Just (ApiT expected)) ] - it "TRANSMETA_CREATE_02 - Transaction with invalid metadata" $ \ctx -> do + it "TRANSMETA_CREATE_02 - Transaction with invalid metadata" $ \ctx -> runResourceT $ do (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx let amt = (minUTxOValue :: Natural) @@ -676,10 +683,10 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do r <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wa) Default payload - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r expectErrorMessage errMsg400TxMetadataStringTooLong r - it "TRANSMETA_CREATE_03 - Transaction with too much metadata" $ \ctx -> do + it "TRANSMETA_CREATE_03 - Transaction with too much metadata" $ \ctx -> runResourceT $ do (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx let amt = (minUTxOValue :: Natural) @@ -696,10 +703,10 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do r <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wa) Default payload - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r expectErrorMessage errMsg400TxTooLarge r - it "TRANSMETA_ESTIMATE_01 - fee estimation includes metadata" $ \ctx -> do + it "TRANSMETA_ESTIMATE_01 - fee estimation includes metadata" $ \ctx -> runResourceT $ do (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx let amt = (minUTxOValue :: Natural) @@ -727,7 +734,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectField (#estimatedMax . #getQuantity) (.< feeEstMax) ] - it "TRANSMETA_ESTIMATE_02 - fee estimation with invalid metadata" $ \ctx -> do + it "TRANSMETA_ESTIMATE_02 - fee estimation with invalid metadata" $ \ctx -> runResourceT $ do (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx let amt = (minUTxOValue :: Natural) @@ -739,10 +746,10 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do r <- request @ApiFee ctx (Link.getTransactionFee @'Shelley wa) Default payload - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r expectErrorMessage errMsg400TxMetadataStringTooLong r - it "TRANSMETA_ESTIMATE_03 - fee estimation with too much metadata" $ \ctx -> do + it "TRANSMETA_ESTIMATE_03 - fee estimation with too much metadata" $ \ctx -> runResourceT $ do (wa, wb) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx let amt = (minUTxOValue :: Natural) @@ -755,14 +762,14 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do | i <- [0..127] ] bytes = [json|{ "bytes": #{T.replicate 64 "a"} }|] let payload = addTxMetadata txMeta basePayload - print payload + liftIO $ print payload r <- request @ApiFee ctx (Link.getTransactionFee @'Shelley wa) Default payload - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r expectErrorMessage errMsg400TxTooLarge r - it "TRANS_EXTERNAL_01 - Single Output Transaction - Shelley witnesses" $ \ctx -> do + it "TRANS_EXTERNAL_01 - Single Output Transaction - Shelley witnesses" $ \ctx -> runResourceT $ do wFaucet <- fixtureWallet ctx let amtSrc = (10_000_000 :: Natural) @@ -775,7 +782,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do "mnemonic_sentence": #{mnemonicsSrc}, "passphrase": #{fixturePassphrase} } |] - r1 <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default walletPostData + r1 <- postWallet ctx walletPostData verify r1 [ expectResponseCode HTTP.status201 , expectField @@ -806,7 +813,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do r3 <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wFaucet) Default payload1 - expectResponseCode @IO HTTP.status202 r3 + expectResponseCode HTTP.status202 r3 let (Hash txid) = getApiT $ getFromResponse #id r3 let txix = case getFromResponse #outputs r3 of @@ -841,7 +848,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do "mnemonic_sentence": #{mnemonicsDest}, "passphrase": #{fixturePassphrase} } |] - r4 <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default walletPostData1 + r4 <- postWallet ctx walletPostData1 verify r4 [ expectSuccess , expectResponseCode HTTP.status201 @@ -902,7 +909,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do let headers = Headers [ ("Content-Type", "application/octet-stream") ] r6 <- request @ApiTxId ctx Link.postExternalTransaction headers (payloadExt encodedSignedTx) - expectResponseCode @IO HTTP.status202 r6 + expectResponseCode HTTP.status202 r6 eventually "wDest and wSrc balances are as expected" $ do r' <- request @ApiWallet ctx @@ -917,7 +924,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (#balance . #getApiT . #available) (`shouldBe` Quantity outChange) r'' - it "TRANS_EXTERNAL_02 - Multiple Outputs Transaction - Shelley witnesses" $ \ctx -> do + it "TRANS_EXTERNAL_02 - Multiple Outputs Transaction - Shelley witnesses" $ \ctx -> runResourceT $ do wFaucet <- fixtureWallet ctx let amt1 = (4_000_000 :: Natural) let amt2 = (6_000_000 :: Natural) @@ -933,7 +940,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do "mnemonic_sentence": #{mnemonicsSrc}, "passphrase": #{fixturePassphrase} } |] - r1 <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default walletPostData + r1 <- postWallet ctx walletPostData verify r1 [ expectResponseCode HTTP.status201 , expectField @@ -963,14 +970,14 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do --- | cardano-address address payment --network-tag 1 \ --- | cardano-address address delegation $(cat stake-src.prv | cardano-address key public) --- --> addr1q895m0p42rwsenhedkjnvnhmvp67p52yrjjc9xn799w0ksctp3s99reas2y8mmf2zz27q557mdkjlux8k8kzgrj526mqyca3zy - payload1 <- mkMultipleTxPayload ctx wSrc amt1 amt2 fixturePassphrase + payload1 <- liftIO $ mkMultipleTxPayload ctx wSrc amt1 amt2 fixturePassphrase r2 <- request @ApiFee ctx (Link.getTransactionFee @'Shelley wFaucet) Default payload1 let (Quantity feeMin) = getFromResponse #estimatedMin r2 r3 <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wFaucet) Default payload1 - expectResponseCode @IO HTTP.status202 r3 + expectResponseCode HTTP.status202 r3 let (Hash txid) = getApiT $ getFromResponse #id r3 let (txix1, txix2) = case getFromResponse #outputs r3 of @@ -1006,7 +1013,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do "mnemonic_sentence": #{mnemonicsDest}, "passphrase": #{fixturePassphrase} } |] - r4 <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default walletPostData1 + r4 <- postWallet ctx walletPostData1 verify r4 [ expectResponseCode HTTP.status201 , expectField @@ -1074,7 +1081,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do let headers = Headers [ ("Content-Type", "application/octet-stream") ] r7 <- request @ApiTxId ctx Link.postExternalTransaction headers (payloadExt encodedSignedTx) - expectResponseCode @IO HTTP.status202 r7 + expectResponseCode HTTP.status202 r7 eventually "wDest and wSrc balances are as expected" $ do r' <- request @ApiWallet ctx @@ -1090,7 +1097,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (`shouldBe` Quantity outChange) r'' describe "TRANS_EXTERNAL_03 - Single Output Transaction with Byron witness" $ - it "Byron wallet" $ \ctx -> do + it "Byron wallet" $ \ctx -> runResourceT $ do wFaucet <- fixtureRandomWallet ctx @@ -1138,7 +1145,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , "address_index": 2147483662 }|] r1 <- request @(ApiAddress n) ctx (Link.postRandomAddress wByron) Default payload1 - expectResponseCode @IO HTTP.status201 r1 + expectResponseCode HTTP.status201 r1 let destination = getFromResponse #id r1 let amtSrc = (10_000_000 :: Natural) let payload2 = Json [json|{ @@ -1197,8 +1204,8 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do "mnemonic_sentence": #{shelleyMnemonics}, "passphrase": #{fixturePassphrase} } |] - r3 <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default walletPostData - expectResponseCode @IO HTTP.status201 r3 + r3 <- postWallet ctx walletPostData + expectResponseCode HTTP.status201 r3 let wShelley = getFromResponse Prelude.id r3 addrs <- listAddresses @n ctx wShelley @@ -1216,7 +1223,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do rFeeEst <- request @ApiFee ctx (Link.getTransactionFee @'Byron wByron) Default payload3 - expectResponseCode @IO HTTP.status202 rFeeEst + expectResponseCode HTTP.status202 rFeeEst let (Quantity feeEstMin) = getFromResponse #estimatedMin rFeeEst let outChange = amtSrc - feeEstMin - amtDest @@ -1259,14 +1266,14 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do ) ] - forM_ matrix $ \(name, nonJson) -> it name $ \ctx -> do + forM_ matrix $ \(name, nonJson) -> it name $ \ctx -> runResourceT $ do w <- emptyWallet ctx let payload = nonJson r <- request @ApiFee ctx (Link.getTransactionFee @'Shelley w) Default payload - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r - it "TRANS_ESTIMATE_03a - we see result when we can't cover fee" $ \ctx -> do + it "TRANS_ESTIMATE_03a - we see result when we can't cover fee" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx payload <- mkTxPayload ctx wSrc faucetAmt fixturePassphrase r <- request @ApiFee ctx @@ -1277,7 +1284,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectField (#estimatedMax . #getQuantity) (.<= oneAda) ] - it "TRANS_ESTIMATE_03b - we see result when we can't cover fee (with withdrawal)" $ \ctx -> do + it "TRANS_ESTIMATE_03b - we see result when we can't cover fee (with withdrawal)" $ \ctx -> runResourceT $ do (wSrc, _) <- rewardWallet ctx addr:_ <- fmap (view #id) <$> listAddresses @n ctx wSrc let totalBalance = wSrc ^. #balance . #getApiT . #total @@ -1297,7 +1304,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectField (#estimatedMax . #getQuantity) (.<= oneAda) ] - it "TRANS_ESTIMATE_04 - Not enough money" $ \ctx -> do + it "TRANS_ESTIMATE_04 - Not enough money" $ \ctx -> runResourceT $ do let (srcAmt, reqAmt) = (minUTxOValue, 2 * minUTxOValue) wSrc <- fixtureWalletWith @n ctx [srcAmt] wDest <- emptyWallet ctx @@ -1310,17 +1317,17 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do errMsg403NotEnoughMoney srcAmt reqAmt ] - it "TRANS_ESTIMATE_07 - Deleted wallet" $ \ctx -> do + it "TRANS_ESTIMATE_07 - Deleted wallet" $ \ctx -> runResourceT $ do w <- emptyWallet ctx _ <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty wDest <- emptyWallet ctx payload <- mkTxPayload ctx wDest minUTxOValue fixturePassphrase r <- request @ApiFee ctx (Link.getTransactionFee @'Shelley w) Default payload - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r - it "TRANS_LIST_01 - Can list Incoming and Outgoing transactions" $ \ctx -> do + it "TRANS_LIST_01 - Can list Incoming and Outgoing transactions" $ \ctx -> runResourceT $ do -- Make tx from fixtureWallet (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx addrs <- listAddresses @n ctx wDest @@ -1354,7 +1361,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do -- Verify Tx list contains Incoming and Outgoing let link = Link.listTransactions @'Shelley wSrc r <- request @([ApiTransaction n]) ctx link Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r verify r [ expectListField 0 (#direction . #getApiT) (`shouldBe` Outgoing) @@ -1386,7 +1393,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do -- 18 | t2 | t2 | descending | 2nd one | -- +---+----------+----------+------------+--------------+ it "TRANS_LIST_02,03x - Can limit/order results with start, end and order" - $ \ctx -> do + $ \ctx -> runResourceT $ do let a1 = Quantity $ sum $ replicate 10 minUTxOValue let a2 = Quantity $ sum $ replicate 10 (2 * minUTxOValue) w <- fixtureWalletWith @n ctx $ mconcat @@ -1580,7 +1587,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do let withQuery q (method, link) = (method, link <> q) - forM_ matrix $ \tc -> do + liftIO $ forM_ matrix $ \tc -> do let link = withQuery (query tc) $ Link.listTransactions @'Shelley w rf <- request @([ApiTransaction n]) ctx link Default Empty verify rf (assertions tc) @@ -1595,7 +1602,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do TestCase { query = toQueryString [ ("start", "2009") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage startEndErr ] @@ -1606,7 +1613,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , ("end", "2016-11-21") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage startEndErr ] @@ -1617,7 +1624,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , ("end", "2016-11-21T10:15:00Z") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage startEndErr ] @@ -1628,7 +1635,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , ("start", "2016-11-21") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage startEndErr ] @@ -1636,7 +1643,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , TestCase { query = toQueryString [ ("order", "scending") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage orderErr ] @@ -1647,7 +1654,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , ("order", "asc") ] , assertions = - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage orderErr ] } @@ -1655,14 +1662,14 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do let withQuery q (method, link) = (method, link <> q) - forM_ queries $ \tc -> it (T.unpack $ query tc) $ \ctx -> do + forM_ queries $ \tc -> it (T.unpack $ query tc) $ \ctx -> runResourceT $ do w <- emptyWallet ctx let link = withQuery (query tc) $ Link.listTransactions @'Shelley w r <- request @([ApiTransaction n]) ctx link Default Empty - verify r (assertions tc) + liftIO $ verify r (assertions tc) it "TRANS_LIST_02 - Start time shouldn't be later than end time" $ - \ctx -> do + \ctx -> runResourceT $ do w <- emptyWallet ctx let startTime = "2009-09-09T09:09:09Z" let endTime = "2001-01-01T01:01:01Z" @@ -1672,13 +1679,13 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (either (const Nothing) Just $ fromText $ T.pack endTime) Nothing r <- request @([ApiTransaction n]) ctx link Default Empty - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r expectErrorMessage (errMsg400StartTimeLaterThanEndTime startTime endTime) r pure () it "TRANS_LIST_03 - Minimum withdrawal shouldn't be 0" $ - \ctx -> do + \ctx -> runResourceT $ do w <- emptyWallet ctx let link = Link.listTransactions' @'Shelley w (Just 0) @@ -1686,12 +1693,12 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do Nothing Nothing r <- request @([ApiTransaction n]) ctx link Default Empty - expectResponseCode @IO HTTP.status400 r + expectResponseCode HTTP.status400 r expectErrorMessage errMsg400MinWithdrawalWrong r pure () it "TRANS_LIST_03 - Minimum withdrawal can be 1, shows empty when no withdrawals" $ - \ctx -> do + \ctx -> runResourceT $ do w <- emptyWallet ctx let link = Link.listTransactions' @'Shelley w (Just 1) @@ -1699,21 +1706,21 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do Nothing Nothing r <- request @([ApiTransaction n]) ctx link Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r let txs = getFromResponse Prelude.id r txs `shouldBe` [] - it "TRANS_LIST_04 - Deleted wallet" $ \ctx -> do + it "TRANS_LIST_04 - Deleted wallet" $ \ctx -> runResourceT $ do w <- emptyWallet ctx _ <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty r <- request @([ApiTransaction n]) ctx (Link.listTransactions @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r it "TRANS_LIST_RANGE_01 - \ \Transaction at time t is SELECTED by small ranges that cover it" $ - \ctx -> do + \ctx -> runResourceT $ do w <- fixtureWalletWith @n ctx [minUTxOValue] t <- unsafeGetTransactionTime <$> listAllTransactions ctx w let (te, tl) = (utcTimePred t, utcTimeSucc t) @@ -1725,7 +1732,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do it "TRANS_LIST_RANGE_02 - \ \Transaction at time t is NOT selected by range (t + 𝛿t, ...)" $ - \ctx -> do + \ctx -> runResourceT $ do w <- fixtureWalletWith @n ctx [minUTxOValue] t <- unsafeGetTransactionTime <$> listAllTransactions ctx w let tl = utcTimeSucc t @@ -1735,7 +1742,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do it "TRANS_LIST_RANGE_03 - \ \Transaction at time t is NOT selected by range (..., t - 𝛿t)" $ - \ctx -> do + \ctx -> runResourceT $ do w <- fixtureWalletWith @n ctx [minUTxOValue] t <- unsafeGetTransactionTime <$> listAllTransactions ctx w let te = utcTimePred t @@ -1743,7 +1750,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do txs2 <- listTransactions @n ctx w (Just te) (Just te) Nothing length <$> [txs1, txs2] `shouldSatisfy` all (== 0) - it "TRANS_GET_01 - Can get Incoming and Outgoing transaction" $ \ctx -> do + it "TRANS_GET_01 - Can get Incoming and Outgoing transaction" $ \ctx -> runResourceT $ do (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx -- post tx let amt = (minUTxOValue :: Natural) @@ -1788,16 +1795,16 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectField (#status . #getApiT) (`shouldBe` InLedger) ] - it "TRANS_GET_02 - Deleted wallet" $ \ctx -> do + it "TRANS_GET_02 - Deleted wallet" $ \ctx -> runResourceT $ do w <- emptyWallet ctx _ <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty let txid = ApiT $ Hash $ BS.pack $ replicate 32 1 let link = Link.getTransaction @'Shelley w (ApiTxId txid) r <- request @(ApiTransaction n) ctx link Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r - it "TRANS_GET_03 - Using wrong transaction id" $ \ctx -> do + it "TRANS_GET_03 - Using wrong transaction id" $ \ctx -> runResourceT $ do (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx -- post tx let amt = (minUTxOValue :: Natural) @@ -1815,12 +1822,12 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do let txid = Hash $ BS.pack $ replicate 32 1 let link = Link.getTransaction @'Shelley wSrc (ApiTxId $ ApiT txid) r <- request @(ApiTransaction n) ctx link Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404CannotFindTx $ toText txid) r it "TRANS_DELETE_01 -\ - \ Shelley: Can forget pending transaction" $ \ctx -> do + \ Shelley: Can forget pending transaction" $ \ctx -> runResourceT $ do (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx -- post tx let amt = (minUTxOValue :: Natural) @@ -1846,7 +1853,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do -- forget transaction request @ApiTxId ctx (Link.deleteTransaction @'Shelley wSrc (ApiTxId txid)) Default Empty - >>= expectResponseCode @IO HTTP.status204 + >>= expectResponseCode HTTP.status204 -- verify again balance on src wallet request @ApiWallet ctx (Link.getWallet @'Shelley wSrc) Default Empty >>= flip verify @@ -1878,7 +1885,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do ] it "TRANS_DELETE_02 -\ - \ Shelley: Cannot forget tx that is already in ledger" $ \ctx -> do + \ Shelley: Cannot forget tx that is already in ledger" $ \ctx -> runResourceT $ do (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx -- post transaction @@ -1901,7 +1908,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do -- Try Forget transaction once it's no longer pending let ep = Link.deleteTransaction @'Shelley wSrc (ApiTxId txid) rDel <- request @ApiTxId ctx ep Default Empty - expectResponseCode @IO HTTP.status403 rDel + expectResponseCode HTTP.status403 rDel let err = errMsg403NoPendingAnymore (toUrlPiece (ApiTxId txid)) expectErrorMessage err rDel @@ -1915,17 +1922,17 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do txDeleteFromDifferentWalletTest emptyRandomWallet "byron-wallets" it "BYRON_TRANS_DELETE -\ - \ Cannot delete tx on Byron wallet using shelley ep" $ \ctx -> do + \ Cannot delete tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let wid = w ^. walletId let txid = "3e6ec12da4414aa0781ff8afa9717ae53ee8cb4aa55d622f65bc62619a4f7b12" let endpoint = "v2/wallets/" <> wid <> "/transactions/" <> txid - r <- request @ApiTxId @IO ctx ("DELETE", endpoint) Default Empty + r <- request @ApiTxId ctx ("DELETE", endpoint) Default Empty expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet wid) r it "BYRON_TRANS_ESTIMATE -\ - \ Cannot estimate tx on Byron wallet using shelley ep" $ \ctx -> do + \ Cannot estimate tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let wid = w ^. walletId wDest <- emptyWallet ctx @@ -1942,11 +1949,11 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do }|] let endpoint = "v2/wallets/" <> wid <> "/payment-fees" r <- request @ApiFee ctx ("POST", endpoint) Default payload - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet wid) r it "BYRON_TRANS_CREATE -\ - \ Cannot create tx on Byron wallet using shelley ep" $ \ctx -> do + \ Cannot create tx on Byron wallet using shelley ep" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let wid = w ^. walletId wDest <- emptyWallet ctx @@ -1964,32 +1971,32 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do }|] let endpoint = "v2/wallets/" <> wid <> "/transactions" r <- request @(ApiTransaction n) ctx ("POST", endpoint) Default payload - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet wid) r it "BYRON_TX_LIST_02 -\ - \ Byron endpoint does not list Shelley wallet transactions" $ \ctx -> do + \ Byron endpoint does not list Shelley wallet transactions" $ \ctx -> runResourceT $ do w <- emptyWallet ctx let wid = w ^. walletId let ep = ("GET", "v2/byron-wallets/" <> wid <> "/transactions") r <- request @([ApiTransaction n]) ctx ep Default Empty verify r - [ expectResponseCode @IO HTTP.status404 + [ expectResponseCode HTTP.status404 , expectErrorMessage (errMsg404NoWallet wid) ] it "BYRON_TX_LIST_03 -\ - \ Shelley endpoint does not list Byron wallet transactions" $ \ctx -> do + \ Shelley endpoint does not list Byron wallet transactions" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let wid = w ^. walletId let ep = ("GET", "v2/wallets/" <> wid <> "/transactions") r <- request @([ApiTransaction n]) ctx ep Default Empty verify r - [ expectResponseCode @IO HTTP.status404 + [ expectResponseCode HTTP.status404 , expectErrorMessage (errMsg404NoWallet wid) ] - it "SHELLEY_TX_REDEEM_01 - Can redeem rewards from self" $ \ctx -> do + it "SHELLEY_TX_REDEEM_01 - Can redeem rewards from self" $ \ctx -> runResourceT $ do (wSrc,_) <- rewardWallet ctx addr:_ <- fmap (view #id) <$> listAddresses @n ctx wSrc @@ -2020,7 +2027,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (`shouldBe` Quantity 0) ] - it "SHELLEY_TX_REDEEM_02 - Can redeem rewards from other" $ \ctx -> do + it "SHELLEY_TX_REDEEM_02 - Can redeem rewards from other" $ \ctx -> runResourceT $ do (wOther, mw) <- rewardWallet ctx wSelf <- fixtureWallet ctx addr:_ <- fmap (view #id) <$> listAddresses @n ctx wSelf @@ -2095,7 +2102,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do (`shouldBe` InLedger) ] - it "SHELLEY_TX_REDEEM_03 - Can't redeem rewards from other if none left" $ \ctx -> do + it "SHELLEY_TX_REDEEM_03 - Can't redeem rewards from other if none left" $ \ctx -> runResourceT $ do (wOther, mw) <- rewardWallet ctx wSelf <- fixtureWallet ctx addr:_ <- fmap (view #id) <$> listAddresses @n ctx wSelf @@ -2128,7 +2135,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectErrorMessage errMsg403WithdrawalNotWorth ] - it "SHELLEY_TX_REDEEM_04 - Can always ask for self redemption" $ \ctx -> do + it "SHELLEY_TX_REDEEM_04 - Can always ask for self redemption" $ \ctx -> runResourceT $ do wSelf <- fixtureWallet ctx addr:_ <- fmap (view #id) <$> listAddresses @n ctx wSelf @@ -2148,11 +2155,11 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectField #withdrawals (`shouldSatisfy` null) ] - it "SHELLEY_TX_REDEEM_05 - Can't redeem rewards from unknown key" $ \ctx -> do + it "SHELLEY_TX_REDEEM_05 - Can't redeem rewards from unknown key" $ \ctx -> runResourceT $ do wSelf <- fixtureWallet ctx addr:_ <- fmap (view #id) <$> listAddresses @n ctx wSelf - mw <- entropyToMnemonic <$> genEntropy @160 + mw <- liftIO $ entropyToMnemonic <$> genEntropy @160 let payload = Json [json|{ "withdrawal": #{mnemonicToText mw}, "payments": [{ @@ -2169,7 +2176,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectErrorMessage errMsg403WithdrawalNotWorth ] - it "SHELLEY_TX_REDEEM_06 - Can't redeem rewards using byron wallet" $ \ctx -> do + it "SHELLEY_TX_REDEEM_06 - Can't redeem rewards using byron wallet" $ \ctx -> runResourceT $ do (wSelf, addrs) <- fixtureIcarusWalletAddrs @n ctx let addr = encodeAddress @n (head addrs) @@ -2189,7 +2196,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectErrorMessage errMsg403NotAShelleyWallet ] - it "SHELLEY_TX_REDEEM_06a - Can't redeem rewards if utxo = 0 from other" $ \ctx -> do + it "SHELLEY_TX_REDEEM_06a - Can't redeem rewards if utxo = 0 from other" $ \ctx -> runResourceT $ do (_, mw) <- rewardWallet ctx wSelf <- emptyWallet ctx addr:_ <- fmap (view #id) <$> listAddresses @n ctx wSelf @@ -2211,7 +2218,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectErrorMessage errMsg403InputsDepleted ] - it "SHELLEY_TX_REDEEM_06b - Can't redeem rewards if utxo = 0 from self" $ \ctx -> do + it "SHELLEY_TX_REDEEM_06b - Can't redeem rewards if utxo = 0 from self" $ \ctx -> runResourceT $ do (wRewards, mw) <- rewardWallet ctx wOther <- emptyWallet ctx @@ -2250,7 +2257,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectErrorMessage errMsg403InputsDepleted ] - it "SHELLEY_TX_REDEEM_07a - Can't redeem rewards if cannot cover fee" $ \ctx -> do + it "SHELLEY_TX_REDEEM_07a - Can't redeem rewards if cannot cover fee" $ \ctx -> runResourceT $ do (_, mw) <- rewardWallet ctx wSelf <- fixtureWalletWith @n ctx [oneThousandAda] addr:_ <- fmap (view #id) <$> listAddresses @n ctx wSelf @@ -2273,7 +2280,7 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do , expectErrorMessage errMsg403Fee ] - it "SHELLEY_TX_REDEEM_07b - Can't redeem rewards if not enough money" $ \ctx -> do + it "SHELLEY_TX_REDEEM_07b - Can't redeem rewards if not enough money" $ \ctx -> runResourceT $ do (_, mw) <- rewardWallet ctx wSelf <- fixtureWalletWith @n ctx [oneThousandAda] addr:_ <- fmap (view #id) <$> listAddresses @n ctx wSelf @@ -2297,22 +2304,22 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do ] where txDeleteNotExistsingTxIdTest eWallet resource = - it resource $ \ctx -> do + it resource $ \ctx -> runResourceT $ do w <- eWallet ctx let walId = w ^. walletId let txid = "3e6ec12da4414aa0781ff8afa9717ae53ee8cb4aa55d622f65bc62619a4f7b12" let endpoint = "v2/" <> T.pack resource <> "/" <> walId <> "/transactions/" <> txid - ra <- request @ApiTxId @IO ctx ("DELETE", endpoint) Default Empty - expectResponseCode @IO HTTP.status404 ra + ra <- request @ApiTxId ctx ("DELETE", endpoint) Default Empty + expectResponseCode HTTP.status404 ra expectErrorMessage (errMsg404CannotFindTx txid) ra txDeleteFromDifferentWalletTest :: (HasType (ApiT WalletId) wal) - => (Context t -> IO wal) + => (Context t -> ResourceT IO wal) -> String -> SpecWith (Context t) txDeleteFromDifferentWalletTest eWallet resource = - it resource $ \ctx -> do + it resource $ \ctx -> runResourceT $ do -- post tx (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx rMkTx <- postTx ctx @@ -2327,16 +2334,17 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do <> wDifferent ^. walletId <> "/transactions/" <> txid - ra <- request @ApiTxId @IO ctx ("DELETE", endpoint) Default Empty - expectResponseCode @IO HTTP.status404 ra + ra <- request @ApiTxId ctx ("DELETE", endpoint) Default Empty + expectResponseCode HTTP.status404 ra expectErrorMessage (errMsg404CannotFindTx txid) ra postTx - :: Context t + :: (MonadIO m, MonadCatch m) + => Context t -> (wal, wal -> (Method, Text), Text) -> ApiWallet -> Natural - -> IO (HTTP.Status, Either RequestException (ApiTransaction n)) + -> m (HTTP.Status, Either RequestException (ApiTransaction n)) postTx ctx (wSrc, postTxEndp, pass) wDest amt = do addrs <- listAddresses @n ctx wDest let destination = (addrs !! 1) ^. #id @@ -2355,11 +2363,12 @@ spec = describe "SHELLEY_TRANSACTIONS" $ do return r mkTxPayload - :: Context t + :: (MonadIO m, MonadCatch m) + => Context t -> ApiWallet -> Natural -> Text - -> IO Payload + -> m Payload mkTxPayload ctx wDest amt passphrase = do addrs <- listAddresses @n ctx wDest let destination = (addrs !! 1) ^. #id diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs index 345c98eab46..5c79be7742a 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Shelley/Wallets.hs @@ -49,6 +49,10 @@ import Cardano.Wallet.Primitive.Types ( walletNameMaxLength, walletNameMinLength ) import Control.Monad ( forM_ ) +import Control.Monad.IO.Class + ( liftIO ) +import Control.Monad.Trans.Resource + ( runResourceT ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.List.NonEmpty @@ -91,9 +95,11 @@ import Test.Integration.Framework.DSL , listAddresses , minUTxOValue , notDelegating + , postWallet + , postWallet' , request , selectCoins - , unsafeRequest + , unsafeResponse , verify , walletId , () @@ -129,9 +135,9 @@ spec :: forall n t. , PaymentAddress n ByronKey ) => SpecWith (Context t) spec = describe "SHELLEY_WALLETS" $ do - it "WALLETS_CREATE_01 - Create a wallet" $ \ctx -> do - m15 <- genMnemonics M15 - m12 <- genMnemonics M12 + it "WALLETS_CREATE_01 - Create a wallet" $ \ctx -> runResourceT $ do + m15 <- liftIO $ genMnemonics M15 + m12 <- liftIO $ genMnemonics M12 let payload = Json [json| { "name": "1st Wallet", "mnemonic_sentence": #{m15}, @@ -139,9 +145,9 @@ spec = describe "SHELLEY_WALLETS" $ do "passphrase": #{fixturePassphrase}, "address_pool_gap": 30 } |] - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload + r <- postWallet ctx payload verify r - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` "1st Wallet") , expectField @@ -173,16 +179,15 @@ spec = describe "SHELLEY_WALLETS" $ do , "new wallet','\346\949\8466\8455\8450\430\8217',\ \'\346\949\8466\8455\8450\430\8217'); DROP TABLE \"wallet\"; --" ) ] - forM_ matrix $ \(nameIn, nameOut) -> it nameIn $ \ctx -> do + forM_ matrix $ \(nameIn, nameOut) -> it nameIn $ \ctx -> runResourceT $ do let payload = Json [json| { "name": #{nameIn}, "mnemonic_sentence": #{mnemonics}, "passphrase": "12345678910" } |] - let postWallet = Link.postWallet @'Shelley - r <- request @ApiWallet ctx postWallet Default payload + r <- postWallet ctx payload verify r - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` nameOut) , expectField @@ -202,19 +207,19 @@ spec = describe "SHELLEY_WALLETS" $ do eventually "listed wallet's state = Ready" $ do rl <- request @[ApiWallet] ctx listWallets Default Empty verify rl - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 1 , expectListField 0 (#state . #getApiT) (`shouldBe` Ready) ] - it "WALLETS_CREATE_02 - Restored wallet preserves funds" $ \ctx -> do + it "WALLETS_CREATE_02 - Restored wallet preserves funds" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx -- create wallet - mnemonics <- mnemonicToText @15 . entropyToMnemonic <$> genEntropy + mnemonics <- liftIO $ mnemonicToText @15 . entropyToMnemonic <$> genEntropy let payldCrt = payloadWith "!st created" mnemonics - rInit <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payldCrt + rInit <- postWallet ctx payldCrt verify rInit - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField (#balance . #getApiT . #available) (`shouldBe` Quantity 0) , expectField (#balance . #getApiT . #total) (`shouldBe` Quantity 0) ] @@ -235,7 +240,7 @@ spec = describe "SHELLEY_WALLETS" $ do }|] rTrans <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload - expectResponseCode @IO HTTP.status202 rTrans + expectResponseCode HTTP.status202 rTrans eventually "Wallet balance is as expected" $ do rGet <- request @ApiWallet ctx @@ -249,11 +254,11 @@ spec = describe "SHELLEY_WALLETS" $ do -- delete wallet rDel <- request @ApiWallet ctx (Link.deleteWallet @'Shelley wDest) Default Empty - expectResponseCode @IO HTTP.status204 rDel + expectResponseCode HTTP.status204 rDel -- restore and make sure funds are there - rRestore <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payldCrt - expectResponseCode @IO HTTP.status201 rRestore + rRestore <- postWallet ctx payldCrt + expectResponseCode HTTP.status201 rRestore eventually "Wallet balance is ok on restored wallet" $ do rGet <- request @ApiWallet ctx (Link.getWallet @'Shelley wDest) Default Empty @@ -264,19 +269,19 @@ spec = describe "SHELLEY_WALLETS" $ do (#balance . #getApiT . #available) (`shouldBe` Quantity minUTxOValue) ] - it "WALLETS_CREATE_03,09 - Cannot create wallet that exists" $ \ctx -> do - m21 <- genMnemonics M21 + it "WALLETS_CREATE_03,09 - Cannot create wallet that exists" $ \ctx -> runResourceT $ do + m21 <- liftIO $ genMnemonics M21 let payload = Json [json| { "name": "Some Wallet", "mnemonic_sentence": #{m21}, "passphrase": #{fixturePassphrase} } |] - r1 <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload - expectResponseCode @IO HTTP.status201 r1 + r1 <- postWallet ctx payload + expectResponseCode HTTP.status201 r1 - r2 <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload + r2 <- postWallet ctx payload verify r2 - [ expectResponseCode @IO HTTP.status409 + [ expectResponseCode HTTP.status409 , expectErrorMessage ("This operation would yield a wallet with the\ \ following id: " ++ T.unpack (getFromResponse walletId r1) ++ " However, I already know of a wallet with this id.") @@ -286,61 +291,61 @@ spec = describe "SHELLEY_WALLETS" $ do let walNameMax = T.pack (replicate walletNameMaxLength 'ą') let matrix = [ ( show walletNameMinLength ++ " char long", "1" - , [ expectResponseCode @IO HTTP.status201 + , [ expectResponseCode HTTP.status201 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` "1") ] ) , ( show walletNameMaxLength ++ " char long", walNameMax - , [ expectResponseCode @IO HTTP.status201 + , [ expectResponseCode HTTP.status201 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` walNameMax) ] ) , ( "Russian name", russianWalletName - , [ expectResponseCode @IO HTTP.status201 + , [ expectResponseCode HTTP.status201 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` russianWalletName) ] ) , ( "Polish name", polishWalletName - , [ expectResponseCode @IO HTTP.status201 + , [ expectResponseCode HTTP.status201 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` polishWalletName) ] ) , ( "Kanji name", kanjiWalletName - , [ expectResponseCode @IO HTTP.status201 + , [ expectResponseCode HTTP.status201 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` kanjiWalletName) ] ) , ( "Arabic name", arabicWalletName - , [ expectResponseCode @IO HTTP.status201 + , [ expectResponseCode HTTP.status201 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` arabicWalletName) ] ) , ( "Wildcards name", wildcardsWalletName - , [ expectResponseCode @IO HTTP.status201 + , [ expectResponseCode HTTP.status201 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` wildcardsWalletName) ] ) ] - forM_ matrix $ \(title, walName, expectations) -> it title $ \ctx -> do - m24 <- genMnemonics M24 + forM_ matrix $ \(title, walName, expectations) -> it title $ \ctx -> runResourceT $ do + m24 <- liftIO $ genMnemonics M24 let payload = Json [json| { "name": #{walName}, "mnemonic_sentence": #{m24}, "passphrase": #{fixturePassphrase} } |] - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload + r <- postWallet ctx payload verify r expectations describe "WALLETS_CREATE_05 - Mnemonics" $ do @@ -351,24 +356,24 @@ spec = describe "SHELLEY_WALLETS" $ do , ( "24 mnemonic words", M24 ) ] - forM_ matrix $ \(title, mnemonics) -> it title $ \ctx -> do - m <- genMnemonics mnemonics + forM_ matrix $ \(title, mnemonics) -> it title $ \ctx -> runResourceT $ do + m <- liftIO $ genMnemonics mnemonics let payload = Json [json| { "name": "Just a łallet", "mnemonic_sentence": #{m}, "passphrase": #{fixturePassphrase} } |] - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload - verify r [ expectResponseCode @IO HTTP.status201 ] + r <- postWallet ctx payload + verify r [ expectResponseCode HTTP.status201 ] describe "WALLETS_CREATE_06 - Mnemonics second factor" $ do let matrix = [ ( "9 mnemonic words", M9 ) , ( "12 mnemonic words", M12 ) ] - forM_ matrix $ \(title, mnemonics) -> it title $ \ctx -> do - m15 <- genMnemonics M15 - mSecondFactor <- genMnemonics mnemonics + forM_ matrix $ \(title, mnemonics) -> it title $ \ctx -> runResourceT $ do + m15 <- liftIO $ genMnemonics M15 + mSecondFactor <- liftIO $ genMnemonics mnemonics let payload = Json [json| { "name": "Just a łallet", @@ -376,8 +381,8 @@ spec = describe "SHELLEY_WALLETS" $ do "mnemonic_second_factor": #{mSecondFactor}, "passphrase": #{fixturePassphrase} } |] - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload - verify r [ expectResponseCode @IO HTTP.status201 ] + r <- postWallet ctx payload + verify r [ expectResponseCode HTTP.status201 ] describe "WALLETS_CREATE_07 - Passphrase" $ do let minLength = passphraseMinLength (Proxy @"raw") @@ -393,15 +398,15 @@ spec = describe "SHELLEY_WALLETS" $ do , ( "Arabic passphrase", arabicWalletName ) , ( "Wildcards passphrase", wildcardsWalletName ) ] - forM_ matrix $ \(title, passphrase) -> it title $ \ctx -> do - m24 <- genMnemonics M24 + forM_ matrix $ \(title, passphrase) -> it title $ \ctx -> runResourceT $ do + m24 <- liftIO $ genMnemonics M24 let payload = Json [json| { "name": "Secure Wallet", "mnemonic_sentence": #{m24}, "passphrase": #{passphrase} } |] - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload - verify r [ expectResponseCode @IO HTTP.status201 ] + r <- postWallet ctx payload + verify r [ expectResponseCode HTTP.status201 ] describe "WALLETS_CREATE_08 - address_pool_gap" $ do let addrPoolMin = fromIntegral @_ @Int $ getAddressPoolGap minBound @@ -414,23 +419,23 @@ spec = describe "SHELLEY_WALLETS" $ do let matrix = [ ( show addrPoolMin , addrPoolMin - , [ expectResponseCode @IO HTTP.status201 + , [ expectResponseCode HTTP.status201 , expectField (#addressPoolGap . #getApiT) (`shouldBe` minBound) ] ) , ( show addrPoolBig , addrPoolBig - , [ expectResponseCode @IO HTTP.status201 + , [ expectResponseCode HTTP.status201 , expectField (#addressPoolGap . #getApiT . #getAddressPoolGap) (`shouldBe` maxDaedalusGap) ] ) ] - forM_ matrix $ \(title, addrPoolGap, expectations) -> it title $ \ctx -> do - m24 <- genMnemonics M24 + forM_ matrix $ \(title, addrPoolGap, expectations) -> it title $ \ctx -> runResourceT $ do + m24 <- liftIO $ genMnemonics M24 let payload = payloadWith' "Secure Wallet" m24 (fromIntegral addrPoolGap) - rW <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload + rW <- postWallet ctx payload verify rW expectations let w = getFromResponse id rW @@ -442,16 +447,16 @@ spec = describe "SHELLEY_WALLETS" $ do [ expectListSize addrPoolGap ] - it "WALLETS_CREATE_08 - default address_pool_gap" $ \ctx -> do - m21 <- genMnemonics M21 + it "WALLETS_CREATE_08 - default address_pool_gap" $ \ctx -> runResourceT $ do + m21 <- liftIO $ genMnemonics M21 let payload = Json [json| { "name": "Secure Wallet", "mnemonic_sentence": #{m21}, "passphrase": "Secure passphrase" } |] - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload + r <- postWallet ctx payload verify r - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField (#addressPoolGap . #getApiT . #getAddressPoolGap) (`shouldBe` 20) ] @@ -459,49 +464,49 @@ spec = describe "SHELLEY_WALLETS" $ do describe "WALLETS_CREATE_09 - HTTP headers" $ do let matrix = [ ( "No HTTP headers -> 415", None - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) , ( "Accept: text/plain -> 406" , Headers [ ("Content-Type", "application/json") , ("Accept", "text/plain") ] - , [ expectResponseCode @IO HTTP.status406 + , [ expectResponseCode HTTP.status406 , expectErrorMessage errMsg406 ] ) , ( "No Accept -> 201" , Headers [ ("Content-Type", "application/json") ] - , [ expectResponseCode @IO HTTP.status201 ] + , [ expectResponseCode HTTP.status201 ] ) , ( "No Content-Type -> 415" , Headers [ ("Accept", "application/json") ] - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) , ( "Content-Type: text/plain -> 415" , Headers [ ("Content-Type", "text/plain") ] - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) ] - forM_ matrix $ \(title, headers, expectations) -> it title $ \ctx -> do - m21 <- genMnemonics M21 + forM_ matrix $ \(title, headers, expectations) -> it title $ \ctx -> runResourceT $ do + m21 <- liftIO $ genMnemonics M21 let payload = Json [json| { "name": "Secure Wallet", "mnemonic_sentence": #{m21}, "passphrase": "Secure passphrase" } |] - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) headers payload + r <- postWallet' ctx headers payload verify r expectations - it "WALLETS_GET_01 - can get wallet details" $ \ctx -> do - (_, w) <- unsafeRequest @ApiWallet ctx (Link.postWallet @'Shelley) simplePayload + it "WALLETS_GET_01 - can get wallet details" $ \ctx -> runResourceT $ do + w <- unsafeResponse <$> (postWallet ctx simplePayload) eventually "I can get all wallet details" $ do rg <- request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty verify rg - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` "Secure Wallet") , expectField @@ -518,18 +523,18 @@ spec = describe "SHELLEY_WALLETS" $ do , expectField #passphrase (`shouldNotBe` Nothing) ] - it "WALLETS_GET_02, WALLETS_DELETE_01 - Deleted wallet is not available" $ \ctx -> do + it "WALLETS_GET_02, WALLETS_DELETE_01 - Deleted wallet is not available" $ \ctx -> runResourceT $ do w <- emptyWallet ctx _ <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty rg <- request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status404 rg + expectResponseCode HTTP.status404 rg expectErrorMessage (errMsg404NoWallet $ w ^. walletId) rg - it "WALLETS_LIST_01 - Created a wallet can be listed" $ \ctx -> do - m18 <- genMnemonics M18 - m9 <- genMnemonics M9 + it "WALLETS_LIST_01 - Created a wallet can be listed" $ \ctx -> runResourceT $ do + m18 <- liftIO $ genMnemonics M18 + m9 <- liftIO $ genMnemonics M9 let payload = Json [json| { "name": "Wallet to be listed", "mnemonic_sentence": #{m18}, @@ -537,10 +542,10 @@ spec = describe "SHELLEY_WALLETS" $ do "passphrase": #{fixturePassphrase}, "address_pool_gap": 20 } |] - _ <- unsafeRequest @ApiWallet ctx (Link.postWallet @'Shelley) payload + _ <- postWallet ctx payload rl <- request @[ApiWallet] ctx (Link.listWallets @'Shelley) Default Empty verify rl - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 1 , expectListField 0 (#name . #getApiT . #getWalletName) @@ -556,19 +561,19 @@ spec = describe "SHELLEY_WALLETS" $ do , expectListField 0 #delegation (`shouldBe` notDelegating []) ] - it "WALLETS_LIST_01 - Wallets are listed from oldest to newest" $ \ctx -> do - m15 <- genMnemonics M15 - m18 <- genMnemonics M18 - m21 <- genMnemonics M21 + it "WALLETS_LIST_01 - Wallets are listed from oldest to newest" $ \ctx -> runResourceT $ do + m15 <- liftIO $ genMnemonics M15 + m18 <- liftIO $ genMnemonics M18 + m21 <- liftIO $ genMnemonics M21 let walletDetails = [("1", m15), ("2", m18) , ("3", m21)] forM_ walletDetails $ \(name, mnemonics) -> do let payload = payloadWith name mnemonics - request @ApiWallet ctx (Link.postWallet @'Shelley) Default payload + postWallet ctx payload rl <- request @[ApiWallet] ctx (Link.listWallets @'Shelley) Default Empty verify rl - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 3 , expectListField 0 (#name . #getApiT . #getWalletName) (`shouldBe` "1") @@ -578,22 +583,22 @@ spec = describe "SHELLEY_WALLETS" $ do (#name . #getApiT . #getWalletName) (`shouldBe` "3") ] - it "WALLETS_LIST_02 - Deleted wallet not listed" $ \ctx -> do + it "WALLETS_LIST_02 - Deleted wallet not listed" $ \ctx -> runResourceT $ do w <- emptyWallet ctx _ <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty rl <- request @[ApiWallet] ctx (Link.listWallets @'Shelley) Default Empty verify rl - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 0 ] - it "WALLETS_UPDATE_01 - Updated wallet name is available" $ \ctx -> do + it "WALLETS_UPDATE_01 - Updated wallet name is available" $ \ctx -> runResourceT $ do - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default simplePayload + r <- postWallet ctx simplePayload let passLastUpdateValue = getFromResponse #passphrase r let newName = updateNamePayload "New great name" let walId = getFromResponse walletId r - let expectations = [ expectResponseCode @IO HTTP.status200 + let expectations = [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` "New great name") @@ -618,7 +623,7 @@ spec = describe "SHELLEY_WALLETS" $ do verify rg expectations rl <- request @[ApiWallet] ctx ("GET", "v2/wallets") Default Empty verify rl - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 1 , expectListField 0 (#name . #getApiT . #getWalletName) (`shouldBe` "New great name") @@ -638,113 +643,113 @@ spec = describe "SHELLEY_WALLETS" $ do let walNameMax = T.pack (replicate walletNameMaxLength 'ą') let matrix = [ ( show walletNameMinLength ++ " char long", "1" - , [ expectResponseCode @IO HTTP.status200 + , [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` "1") ] ) , ( show walletNameMaxLength ++ " char long", walNameMax - , [ expectResponseCode @IO HTTP.status200 + , [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` walNameMax) ] ) , ( "Russian name", russianWalletName - , [ expectResponseCode @IO HTTP.status200 + , [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` russianWalletName) ] ) , ( "Polish name", polishWalletName - , [ expectResponseCode @IO HTTP.status200 + , [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` polishWalletName) ] ) , ( "Kanji name", kanjiWalletName - , [ expectResponseCode @IO HTTP.status200 + , [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` kanjiWalletName) ] ) , ( "Arabic name", arabicWalletName - , [ expectResponseCode @IO HTTP.status200 + , [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` arabicWalletName) ] ) , ( "Wildcards name", wildcardsWalletName - , [ expectResponseCode @IO HTTP.status200 + , [ expectResponseCode HTTP.status200 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` wildcardsWalletName) ] ) ] - forM_ matrix $ \(title, walName, expectations) -> it title $ \ctx -> do - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default simplePayload + forM_ matrix $ \(title, walName, expectations) -> it title $ \ctx -> runResourceT $ do + r <- postWallet ctx simplePayload let newName = updateNamePayload walName let endpoint = "v2/wallets" (getFromResponse walletId r) ru <- request @ApiWallet ctx ("PUT", endpoint) Default newName verify ru expectations - it "WALLETS_UPDATE_03 - Deleted wallet cannot be updated (404)" $ \ctx -> do - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default simplePayload + it "WALLETS_UPDATE_03 - Deleted wallet cannot be updated (404)" $ \ctx -> runResourceT $ do + r <- postWallet ctx simplePayload let wid = getFromResponse walletId r let endpoint = "v2/wallets" wid _ <- request @ApiWallet ctx ("DELETE", endpoint) Default Empty let newName = updateNamePayload "new name" ru <- request @ApiWallet ctx ("PUT", endpoint) Default newName - expectResponseCode @IO HTTP.status404 ru + expectResponseCode HTTP.status404 ru expectErrorMessage (errMsg404NoWallet wid) ru describe "WALLETS_UPDATE_04 - HTTP headers" $ do let matrix = [ ( "No HTTP headers -> 415", None - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) , ( "Accept: text/plain -> 406" , Headers [ ("Content-Type", "application/json") , ("Accept", "text/plain") ] - , [ expectResponseCode @IO HTTP.status406 + , [ expectResponseCode HTTP.status406 , expectErrorMessage errMsg406 ] ) , ( "No Accept -> 200" , Headers [ ("Content-Type", "application/json") ] - , [ expectResponseCode @IO HTTP.status200 ] + , [ expectResponseCode HTTP.status200 ] ) , ( "No Content-Type -> 415" , Headers [ ("Accept", "application/json") ] - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) , ( "Content-Type: text/plain -> 415" , Headers [ ("Content-Type", "text/plain") ] - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) ] - forM_ matrix $ \(title, headers, expectations) -> it title $ \ctx -> do - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default simplePayload + forM_ matrix $ \(title, headers, expectations) -> it title $ \ctx -> runResourceT $ do + r <- postWallet ctx simplePayload let newName = updateNamePayload "new name" let endpoint = "v2/wallets" (getFromResponse walletId r) ru <- request @ApiWallet ctx ("PUT", endpoint) headers newName verify ru expectations - it "WALLETS_UPDATE_PASS_01 - passphaseLastUpdate gets updated" $ \ctx -> do - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default simplePayload + it "WALLETS_UPDATE_PASS_01 - passphaseLastUpdate gets updated" $ \ctx -> runResourceT $ do + r <- postWallet ctx simplePayload let payload = updatePassPayload fixturePassphrase "New passphrase" let endpoint = "v2/wallets" (getFromResponse walletId r) ("passphrase" :: Text) rup <- request @ApiWallet ctx ("PUT", endpoint) Default payload - expectResponseCode @IO HTTP.status204 rup + expectResponseCode HTTP.status204 rup let getEndpoint = "v2/wallets" (getFromResponse walletId r) let originalPassUpdateDateTime = getFromResponse #passphrase r @@ -757,44 +762,44 @@ spec = describe "SHELLEY_WALLETS" $ do let matrix = [ ( show minLength ++ " char long" , T.pack (replicate minLength 'ź') - , [ expectResponseCode @IO HTTP.status204 + , [ expectResponseCode HTTP.status204 ] ) , ( show maxLength ++ " char long" , T.pack (replicate maxLength 'ą') - , [ expectResponseCode @IO HTTP.status204 ] + , [ expectResponseCode HTTP.status204 ] ) , ( "Russian passphrase", russianWalletName - , [ expectResponseCode @IO HTTP.status204 ] + , [ expectResponseCode HTTP.status204 ] ) , ( "Polish passphrase", polishWalletName - , [ expectResponseCode @IO HTTP.status204 ] + , [ expectResponseCode HTTP.status204 ] ) , ( "Kanji passphrase", kanjiWalletName - , [ expectResponseCode @IO HTTP.status204 ] + , [ expectResponseCode HTTP.status204 ] ) , ( "Arabic passphrase", arabicWalletName - , [ expectResponseCode @IO HTTP.status204 ] + , [ expectResponseCode HTTP.status204 ] ) , ( "Wildcards passphrase", wildcardsWalletName - , [ expectResponseCode @IO HTTP.status204 ] + , [ expectResponseCode HTTP.status204 ] ) ] - forM_ matrix $ \(title, passphrase, expectations) -> it title $ \ctx -> do - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default simplePayload + forM_ matrix $ \(title, passphrase, expectations) -> it title $ \ctx -> runResourceT $ do + r <- postWallet ctx simplePayload let payload = updatePassPayload fixturePassphrase passphrase let endpoint = "v2/wallets" (getFromResponse walletId r) ("passphrase" :: Text) rup <- request @ApiWallet ctx ("PUT", endpoint) Default payload verify rup expectations - it "WALLETS_UPDATE_PASS_03 - Old passphrase incorrect" $ \ctx -> do + it "WALLETS_UPDATE_PASS_03 - Old passphrase incorrect" $ \ctx -> runResourceT $ do w <- emptyWalletWith ctx ("Wallet to update pass", "cardano-passphrase", 20) let payload = updatePassPayload "incorrect-passphrase" "whatever-pass" rup <- request @ApiWallet ctx (Link.putWalletPassphrase @'Shelley w) Default payload - expectResponseCode @IO HTTP.status403 rup + expectResponseCode HTTP.status403 rup expectErrorMessage errMsg403WrongPass rup describe "WALLETS_UPDATE_PASS_03 - Can update pass from pass that's boundary\ @@ -812,50 +817,49 @@ spec = describe "SHELLEY_WALLETS" $ do , ( "Arabic passphrase", arabicWalletName ) , ( "Wildcards passphrase", wildcardsWalletName ) ] - forM_ matrix $ \(title, oldPass) -> it title $ \ctx -> do - m24 <- genMnemonics M24 + forM_ matrix $ \(title, oldPass) -> it title $ \ctx -> runResourceT $ do + m24 <- liftIO $ genMnemonics M24 let createPayload = Json [json| { "name": "Name of the wallet", "mnemonic_sentence": #{m24}, "passphrase": #{oldPass} } |] - (_, w) <- unsafeRequest @ApiWallet ctx - (Link.postWallet @'Shelley) createPayload + w <- unsafeResponse <$> postWallet ctx createPayload let len = passphraseMaxLength (Proxy @"raw") let newPass = T.pack $ replicate len '💘' let payload = updatePassPayload oldPass newPass rup <- request @ApiWallet ctx (Link.putWalletPassphrase @'Shelley w) Default payload - expectResponseCode @IO HTTP.status204 rup + expectResponseCode HTTP.status204 rup - it "WALLETS_UPDATE_PASS_04 - Deleted wallet is not available" $ \ctx -> do - r <- request @ApiWallet ctx (Link.postWallet @'Shelley) Default simplePayload + it "WALLETS_UPDATE_PASS_04 - Deleted wallet is not available" $ \ctx -> runResourceT $ do + r <- postWallet ctx simplePayload let payload = updatePassPayload fixturePassphrase "Secure passphrase2" let walId = getFromResponse walletId r let delEndp = "v2/wallets" walId _ <- request @ApiWallet ctx ("DELETE", delEndp) Default Empty let updEndp = delEndp ("passphrase" :: Text) rup <- request @ApiWallet ctx ("PUT", updEndp) Default payload - expectResponseCode @IO HTTP.status404 rup + expectResponseCode HTTP.status404 rup expectErrorMessage (errMsg404NoWallet walId) rup describe "WALLETS_UPDATE_PASS_05,06 - Transaction after updating passphrase" $ do let oldPass = "cardano-wallet" let newPass = "cardano-wallet2" let matrix = [ ("Old passphrase -> fail", oldPass - , [ expectResponseCode @IO HTTP.status403 + , [ expectResponseCode HTTP.status403 , expectErrorMessage errMsg403WrongPass ] ) , ("New passphrase -> OK", newPass - , [ expectResponseCode @IO HTTP.status202 ] ) + , [ expectResponseCode HTTP.status202 ] ) ] - forM_ matrix $ \(title, pass, expectations) -> it title $ \ctx -> do + forM_ matrix $ \(title, pass, expectations) -> it title $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx let payloadUpdate = updatePassPayload oldPass newPass rup <- request @ApiWallet ctx (Link.putWalletPassphrase @'Shelley wSrc) Default payloadUpdate - expectResponseCode @IO HTTP.status204 rup + expectResponseCode HTTP.status204 rup addrs <- listAddresses @n ctx wDest let destination = (addrs !! 1) ^. #id @@ -876,32 +880,32 @@ spec = describe "SHELLEY_WALLETS" $ do describe "WALLETS_UPDATE_PASS_07 - HTTP headers" $ do let matrix = [ ( "No HTTP headers -> 415", None - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) , ( "Accept: text/plain -> 406" , Headers [ ("Content-Type", "application/json") , ("Accept", "text/plain") ] - , [ expectResponseCode @IO HTTP.status204 ] + , [ expectResponseCode HTTP.status204 ] ) , ( "No Accept -> 204" , Headers [ ("Content-Type", "application/json") ] - , [ expectResponseCode @IO HTTP.status204 ] + , [ expectResponseCode HTTP.status204 ] ) , ( "No Content-Type -> 415" , Headers [ ("Accept", "application/json") ] - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) , ( "Content-Type: text/plain -> 415" , Headers [ ("Content-Type", "text/plain") ] - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) ] - forM_ matrix $ \(title, headers, expectations) -> it title $ \ctx -> do - (_, w) <- unsafeRequest @ApiWallet ctx (Link.postWallet @'Shelley) simplePayload + forM_ matrix $ \(title, headers, expectations) -> it title $ \ctx -> runResourceT $ do + w <- unsafeResponse <$> postWallet ctx simplePayload let payload = updatePassPayload fixturePassphrase "Passphrase" let endpoint = Link.putWalletPassphrase @'Shelley w rup <- request @ApiWallet ctx endpoint headers payload @@ -909,13 +913,13 @@ spec = describe "SHELLEY_WALLETS" $ do it "WALLETS_COIN_SELECTION_01 - \ \A singleton payment is included in the coin selection output." $ - \ctx -> do + \ctx -> runResourceT @IO $ do source <- fixtureWallet ctx target <- emptyWallet ctx targetAddress : _ <- fmap (view #id) <$> listAddresses @n ctx target let amount = Quantity minUTxOValue let payment = AddressAmount targetAddress amount - selectCoins @_ @'Shelley ctx source (payment :| []) >>= flip verify + liftIO $ selectCoins @_ @'Shelley ctx source (payment :| []) >>= flip verify [ expectResponseCode HTTP.status200 , expectField #inputs (`shouldSatisfy` (not . null)) , expectField #outputs (`shouldSatisfy` ((> 1) . length)) @@ -925,7 +929,7 @@ spec = describe "SHELLEY_WALLETS" $ do let satisfy = flip shouldSatisfy it "WALLETS_COIN_SELECTION_02 - \ \Multiple payments are all included in the coin selection output." $ - \ctx -> do + \ctx -> runResourceT $ do let paymentCount = 10 source <- fixtureWallet ctx target <- emptyWallet ctx @@ -934,7 +938,7 @@ spec = describe "SHELLEY_WALLETS" $ do let payments = NE.fromList $ take paymentCount $ zipWith AddressAmount targetAddresses amounts - selectCoins @_ @'Shelley ctx source payments >>= flip verify + liftIO $ selectCoins @_ @'Shelley ctx source payments >>= flip verify [ expectResponseCode HTTP.status200 , expectField @@ -946,18 +950,18 @@ spec = describe "SHELLEY_WALLETS" $ do ] it "WALLETS_COIN_SELECTION_03 - \ - \Deleted wallet is not available for selection" $ \ctx -> do + \Deleted wallet is not available for selection" $ \ctx -> runResourceT $ do w <- emptyWallet ctx (addr:_) <- fmap (view #id) <$> listAddresses @n ctx w let payments = NE.fromList [ AddressAmount addr (Quantity minUTxOValue) ] _ <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty - selectCoins @_ @'Shelley ctx w payments >>= flip verify - [ expectResponseCode @IO HTTP.status404 + liftIO $ selectCoins @_ @'Shelley ctx w payments >>= flip verify + [ expectResponseCode HTTP.status404 , expectErrorMessage (errMsg404NoWallet $ w ^. walletId) ] it "WALLETS_COIN_SELECTION_03 - \ - \Wrong selection method (not 'random')" $ \ctx -> do + \Wrong selection method (not 'random')" $ \ctx -> runResourceT $ do w <- fixtureWallet ctx (addr:_) <- fmap (view #id) <$> listAddresses @n ctx w let payments = NE.fromList [ AddressAmount addr (Quantity minUTxOValue) ] @@ -969,13 +973,13 @@ spec = describe "SHELLEY_WALLETS" $ do ] forM_ endpoints $ \endpoint -> do r <- request @(ApiCoinSelection n) ctx endpoint Default payload - verify r [ expectResponseCode @IO HTTP.status404 ] + verify r [ expectResponseCode HTTP.status404 ] describe "WALLETS_COIN_SELECTION_04 - HTTP headers" $ do let matrix = [ ( "No HTTP headers -> 415" , None - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) @@ -984,28 +988,28 @@ spec = describe "SHELLEY_WALLETS" $ do [ ("Content-Type", "application/json") , ("Accept", "text/plain") ] - , [ expectResponseCode @IO HTTP.status406 + , [ expectResponseCode HTTP.status406 , expectErrorMessage errMsg406 ] ) , ( "No Accept -> 200" , Headers [ ("Content-Type", "application/json") ] - , [ expectResponseCode @IO HTTP.status200 ] + , [ expectResponseCode HTTP.status200 ] ) , ( "No Content-Type -> 415" , Headers [ ("Accept", "application/json") ] - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) , ( "Content-Type: text/plain -> 415" , Headers [ ("Content-Type", "text/plain") ] - , [ expectResponseCode @IO HTTP.status415 + , [ expectResponseCode HTTP.status415 , expectErrorMessage errMsg415 ] ) ] - forM_ matrix $ \(title, headers, expectations) -> it title $ \ctx -> do + forM_ matrix $ \(title, headers, expectations) -> it title $ \ctx -> runResourceT $ do w <- fixtureWallet ctx (addr:_) <- fmap (view #id) <$> listAddresses @n ctx w let payments = NE.fromList [ AddressAmount addr (Quantity minUTxOValue) ] @@ -1014,14 +1018,14 @@ spec = describe "SHELLEY_WALLETS" $ do (Link.selectCoins @'Shelley w) headers payload verify r expectations - it "WALLETS_UTXO_01 - Wallet's inactivity is reflected in utxo" $ \ctx -> do + it "WALLETS_UTXO_01 - Wallet's inactivity is reflected in utxo" $ \ctx -> runResourceT $ do w <- emptyWallet ctx rStat <- request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status200 rStat + expectResponseCode HTTP.status200 rStat expectWalletUTxO [] (snd rStat) - it "WALLETS_UTXO_02 - Sending and receiving funds updates wallet's utxo." $ \ctx -> do + it "WALLETS_UTXO_02 - Sending and receiving funds updates wallet's utxo." $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx @@ -1042,7 +1046,7 @@ spec = describe "SHELLEY_WALLETS" $ do rTrans <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default (Json payload) - expectResponseCode @IO HTTP.status202 rTrans + expectResponseCode HTTP.status202 rTrans eventually "Wallet balance is as expected" $ do rGet <- request @ApiWallet ctx @@ -1059,50 +1063,50 @@ spec = describe "SHELLEY_WALLETS" $ do --verify utxo rStat1 <- request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Shelley wDest) Default Empty - expectResponseCode @IO HTTP.status200 rStat1 + expectResponseCode HTTP.status200 rStat1 expectWalletUTxO coins (snd rStat1) - it "WALLETS_UTXO_03 - Deleted wallet is not available for utxo" $ \ctx -> do + it "WALLETS_UTXO_03 - Deleted wallet is not available for utxo" $ \ctx -> runResourceT $ do w <- emptyWallet ctx _ <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty r <- request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r describe "WALLETS_UTXO_04 - HTTP headers" $ do let matrix = [ ( "No HTTP headers -> 200" , None - , [ expectResponseCode @IO HTTP.status200 ] ) + , [ expectResponseCode HTTP.status200 ] ) , ( "Accept: text/plain -> 406" , Headers [ ("Content-Type", "application/json") , ("Accept", "text/plain") ] - , [ expectResponseCode @IO HTTP.status406 + , [ expectResponseCode HTTP.status406 , expectErrorMessage errMsg406 ] ) , ( "No Accept -> 200" , Headers [ ("Content-Type", "application/json") ] - , [ expectResponseCode @IO HTTP.status200 ] + , [ expectResponseCode HTTP.status200 ] ) , ( "No Content-Type -> 200" , Headers [ ("Accept", "application/json") ] - , [ expectResponseCode @IO HTTP.status200 ] + , [ expectResponseCode HTTP.status200 ] ) , ( "Content-Type: text/plain -> 200" , Headers [ ("Content-Type", "text/plain") ] - , [ expectResponseCode @IO HTTP.status200 ] + , [ expectResponseCode HTTP.status200 ] ) ] - forM_ matrix $ \(title, headers, expectations) -> it title $ \ctx -> do + forM_ matrix $ \(title, headers, expectations) -> it title $ \ctx -> runResourceT $ do w <- emptyWallet ctx r <- request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Shelley w) headers Empty verify r expectations it "BYRON_WALLETS_UTXO -\ - \ Cannot show Byron wal utxo with shelley ep (404)" $ \ctx -> do + \ Cannot show Byron wal utxo with shelley ep (404)" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let wid = w ^. walletId let endpoint = @@ -1110,11 +1114,11 @@ spec = describe "SHELLEY_WALLETS" $ do wid ("statistics/utxos" :: Text) r <- request @ApiUtxoStatistics ctx ("GET", endpoint) Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet wid) r it "BYRON_WALLETS_UPDATE_PASS -\ - \ Cannot update Byron wal with shelley ep (404)" $ \ctx -> do + \ Cannot update Byron wal with shelley ep (404)" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let payload = updatePassPayload fixturePassphrase "Secure passphrase2" let wid = w ^. walletId @@ -1123,39 +1127,39 @@ spec = describe "SHELLEY_WALLETS" $ do wid ("passphrase" :: Text) rup <- request @ApiWallet ctx ("PUT", endpoint) Default payload - expectResponseCode @IO HTTP.status404 rup + expectResponseCode HTTP.status404 rup expectErrorMessage (errMsg404NoWallet wid) rup it "BYRON_WALLETS_UPDATE -\ - \ Cannot update Byron wal with shelley ep (404)" $ \ctx -> do + \ Cannot update Byron wal with shelley ep (404)" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let wid = w ^. walletId let endpoint = "v2/wallets" wid let newName = updateNamePayload "new name" ru <- request @ApiWallet ctx ("PUT", endpoint) Default newName - expectResponseCode @IO HTTP.status404 ru + expectResponseCode HTTP.status404 ru expectErrorMessage (errMsg404NoWallet wid) ru - it "BYRON_GET_02 - Byron ep does not show Shelley wallet" $ \ctx -> do + it "BYRON_GET_02 - Byron ep does not show Shelley wallet" $ \ctx -> runResourceT $ do w <- emptyWallet ctx r <- request @ApiByronWallet ctx (Link.getWallet @'Byron w) Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r - it "BYRON_GET_03 - Shelley ep does not show Byron wallet" $ \ctx -> do + it "BYRON_GET_03 - Shelley ep does not show Byron wallet" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx r <- request @ApiWallet ctx (Link.getWallet @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r it "BYRON_LIST_02,03 -\ \ Byron wallets listed only via Byron endpoints \\\ - \ Shelley wallets listed only via new endpoints" $ \ctx -> do - m1 <- genMnemonics M12 - m2 <- genMnemonics M12 - m3 <- genMnemonics M12 + \ Shelley wallets listed only via new endpoints" $ \ctx -> runResourceT $ do + m1 <- liftIO $ genMnemonics M12 + m2 <- liftIO $ genMnemonics M12 + m3 <- liftIO $ genMnemonics M12 _ <- emptyByronWalletWith ctx "random" ("byron1", m1, fixturePassphrase) _ <- emptyByronWalletWith ctx "random" ("byron2", m2, fixturePassphrase) _ <- emptyByronWalletWith ctx "random" ("byron3", m3, fixturePassphrase) @@ -1167,7 +1171,7 @@ spec = describe "SHELLEY_WALLETS" $ do --list only byron rl <- request @[ApiByronWallet] ctx (Link.listWallets @'Byron) Default Empty verify rl - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 3 , expectListField 0 (#name . #getApiT . #getWalletName) (`shouldBe` "byron1") @@ -1179,7 +1183,7 @@ spec = describe "SHELLEY_WALLETS" $ do --list only shelley rl2 <- request @[ApiWallet] ctx (Link.listWallets @'Shelley) Default Empty verify rl2 - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 3 , expectListField 0 (#name . #getApiT . #getWalletName) (`shouldBe` "shelley1") @@ -1190,10 +1194,10 @@ spec = describe "SHELLEY_WALLETS" $ do ] it "BYRON_LIST_04, DELETE_01 -\ - \ Deleted wallets cannot be listed" $ \ctx -> do - m1 <- genMnemonics M12 - m2 <- genMnemonics M12 - m3 <- genMnemonics M12 + \ Deleted wallets cannot be listed" $ \ctx -> runResourceT $ do + m1 <- liftIO $ genMnemonics M12 + m2 <- liftIO $ genMnemonics M12 + m3 <- liftIO $ genMnemonics M12 _ <- emptyByronWalletWith ctx "random" ("byron1", m1, fixturePassphrase) wb2 <- emptyByronWalletWith ctx "random" ("byron2", m2, fixturePassphrase) _ <- emptyByronWalletWith ctx "random" ("byron3", m3, fixturePassphrase) @@ -1209,7 +1213,7 @@ spec = describe "SHELLEY_WALLETS" $ do --list only byron rdl <- request @[ApiByronWallet] ctx (Link.listWallets @'Byron) Default Empty verify rdl - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 2 , expectListField 0 (#name . #getApiT . #getWalletName) (`shouldBe` "byron1") @@ -1219,7 +1223,7 @@ spec = describe "SHELLEY_WALLETS" $ do --list only shelley rdl2 <- request @[ApiWallet] ctx (Link.listWallets @'Shelley) Default Empty verify rdl2 - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 2 , expectListField 0 (#name . #getApiT . #getWalletName) (`shouldBe` "shelley1") @@ -1227,20 +1231,19 @@ spec = describe "SHELLEY_WALLETS" $ do (#name . #getApiT . #getWalletName) (`shouldBe` "shelley2") ] - it "BYRON_DELETE_02 - Byron ep does not delete Shelley wallet" $ \ctx -> do + it "BYRON_DELETE_02 - Byron ep does not delete Shelley wallet" $ \ctx -> runResourceT $ do w <- emptyWallet ctx r <- request @ApiByronWallet ctx (Link.deleteWallet @'Byron w) Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r - it "BYRON_DELETE_03 - Shelley ep does not delete Byron wallet" $ \ctx -> do + it "BYRON_DELETE_03 - Shelley ep does not delete Byron wallet" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx r <- request @ApiByronWallet ctx (Link.deleteWallet @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r - it "NETWORK_SHELLEY - Wallet has the same tip as network/information" $ - \ctx -> do + it "NETWORK_SHELLEY - Wallet has the same tip as network/information" $ \ctx -> runResourceT $ do let getNetworkInfo = request @ApiNetworkInformation ctx Link.getNetworkInfo Default Empty w <- emptyWallet ctx diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Byron/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Byron/Addresses.hs index d39b370f831..3bfd2d3feae 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Byron/Addresses.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Byron/Addresses.hs @@ -30,6 +30,10 @@ import Cardano.Wallet.Primitive.Types ( AddressState (..) ) import Control.Monad ( forM_ ) +import Control.Monad.IO.Class + ( liftIO ) +import Control.Monad.Trans.Resource + ( ResourceT, runResourceT ) import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.Proxy @@ -121,19 +125,20 @@ scenario_ADDRESS_LIST_01 , KnownCommand t ) => String - -> (Context t -> IO ApiByronWallet) + -> (Context t -> ResourceT IO ApiByronWallet) -> SpecWith (Context t) -scenario_ADDRESS_LIST_01 walType fixture = it title $ \ctx -> do +scenario_ADDRESS_LIST_01 walType fixture = it title $ \ctx -> runResourceT $ do w <- fixture ctx let wid = T.unpack (w ^. walletId) (Exit c, Stdout out, Stderr err) <- listAddressesViaCLI @t ctx [wid] - err `shouldBe` cmdOk - c `shouldBe` ExitSuccess - j <- expectValidJSON (Proxy @[ApiAddress n]) out - let n = length j - forM_ [0..(n-1)] $ \addrNum -> do - expectCliListField - addrNum (#state . #getApiT) (`shouldBe` Unused) j + liftIO $ do + err `shouldBe` cmdOk + c `shouldBe` ExitSuccess + j <- expectValidJSON (Proxy @[ApiAddress n]) out + let n = length j + forM_ [0..(n-1)] $ \addrNum -> do + expectCliListField + addrNum (#state . #getApiT) (`shouldBe` Unused) j where title = "CLI_ADDRESS_LIST_01 - " ++ walType ++ " can list known addresses on a default wallet" @@ -145,9 +150,9 @@ scenario_ADDRESS_LIST_02 , KnownCommand t ) => String - -> (Context t -> IO ApiByronWallet) + -> (Context t -> ResourceT IO ApiByronWallet) -> SpecWith (Context t) -scenario_ADDRESS_LIST_02 walType fixture = it title $ \ctx -> do +scenario_ADDRESS_LIST_02 walType fixture = it title $ \ctx -> runResourceT $ do w <- fixture ctx let wid = T.unpack (w ^. walletId) let args u = [ wid @@ -155,23 +160,24 @@ scenario_ADDRESS_LIST_02 walType fixture = it title $ \ctx -> do ] -- filtering --state=used (Exit c, Stdout out, Stderr err) <- listAddressesViaCLI @t ctx (args "used") - err `shouldBe` cmdOk - c `shouldBe` ExitSuccess - j <- expectValidJSON (Proxy @[ApiAddress n]) out - let n = length j - forM_ [0..(n-1)] $ \addrNum -> do - expectCliListField - addrNum (#state . #getApiT) (`shouldBe` Used) j + liftIO $ do + err `shouldBe` cmdOk + c `shouldBe` ExitSuccess + j <- expectValidJSON (Proxy @[ApiAddress n]) out + let n = length j + forM_ [0..(n-1)] $ \addrNum -> do + expectCliListField + addrNum (#state . #getApiT) (`shouldBe` Used) j - -- filtering --state unused - (Exit c2, Stdout out2, Stderr err2) <- listAddressesViaCLI @t ctx (args "unused") - err2 `shouldBe` cmdOk - c2 `shouldBe` ExitSuccess - j2 <- expectValidJSON (Proxy @[ApiAddress n]) out2 - let n2 = length j2 - forM_ [0..(n2-1)] $ \addrNum -> do - expectCliListField - addrNum (#state . #getApiT) (`shouldBe` Unused) j2 + -- filtering --state unused + (Exit c2, Stdout out2, Stderr err2) <- listAddressesViaCLI @t ctx (args "unused") + err2 `shouldBe` cmdOk + c2 `shouldBe` ExitSuccess + j2 <- expectValidJSON (Proxy @[ApiAddress n]) out2 + let n2 = length j2 + forM_ [0..(n2-1)] $ \addrNum -> do + expectCliListField + addrNum (#state . #getApiT) (`shouldBe` Unused) j2 where title = "CLI_ADDRESS_LIST_02 - " ++ walType ++ " can filter used and unused addresses" @@ -183,17 +189,18 @@ scenario_ADDRESS_LIST_04 , KnownCommand t ) => String - -> (Context t -> IO ApiByronWallet) + -> (Context t -> ResourceT IO ApiByronWallet) -> SpecWith (Context t) -scenario_ADDRESS_LIST_04 walType fixture = it title $ \ctx -> do +scenario_ADDRESS_LIST_04 walType fixture = it title $ \ctx -> runResourceT $ do w <- fixture ctx let wid = w ^. walletId Exit cd <- deleteWalletViaCLI @t ctx $ T.unpack wid - cd `shouldBe` ExitSuccess - (Exit c, Stdout out, Stderr err) <- listAddressesViaCLI @t ctx [T.unpack wid] - err `shouldContain` (errMsg404NoWallet wid) - c `shouldBe` ExitFailure 1 - out `shouldBe` mempty + liftIO $ do + cd `shouldBe` ExitSuccess + (Exit c, Stdout out, Stderr err) <- listAddressesViaCLI @t ctx [T.unpack wid] + err `shouldContain` (errMsg404NoWallet wid) + c `shouldBe` ExitFailure 1 + out `shouldBe` mempty where title = "CLI_ADDRESS_LIST_04 - " ++ walType ++ " deleted wallet" @@ -204,14 +211,15 @@ scenario_ADDRESS_CREATE_01 , KnownCommand t ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_01 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_01 = it title $ \ctx -> runResourceT @IO $ do w <- emptyRandomWallet ctx let wid = T.unpack (w ^. walletId) (c, out, err) <- createAddressViaCLI @t ctx [wid] (T.unpack fixturePassphrase) - T.unpack err `shouldContain` cmdOk - c `shouldBe` ExitSuccess - j <- expectValidJSON (Proxy @(ApiAddress n)) (T.unpack out) - verify j [ expectCliField #state (`shouldBe` ApiT Unused) ] + liftIO $ do + T.unpack err `shouldContain` cmdOk + c `shouldBe` ExitSuccess + j <- expectValidJSON (Proxy @(ApiAddress n)) (T.unpack out) + verify j [ expectCliField #state (`shouldBe` ApiT Unused) ] where title = "CLI_ADDRESS_CREATE_01 - Can create a random address without index" @@ -222,13 +230,14 @@ scenario_ADDRESS_CREATE_02 , KnownCommand t ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_02 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_02 = it title $ \ctx -> runResourceT @IO $ do w <- emptyIcarusWallet ctx let wid = T.unpack (w ^. walletId) (c, out, err) <- createAddressViaCLI @t ctx [wid] (T.unpack fixturePassphrase) - T.unpack err `shouldContain` errMsg403NotAByronWallet - c `shouldBe` ExitFailure 1 - out `shouldBe` mempty + liftIO $ do + T.unpack err `shouldContain` errMsg403NotAByronWallet + c `shouldBe` ExitFailure 1 + out `shouldBe` mempty where title = "CLI_ADDRESS_CREATE_02 - Creation is forbidden on Icarus wallets" @@ -239,13 +248,14 @@ scenario_ADDRESS_CREATE_03 , KnownCommand t ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_03 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_03 = it title $ \ctx -> runResourceT @IO $ do w <- emptyRandomWallet ctx let wid = T.unpack (w ^. walletId) (c, out, err) <- createAddressViaCLI @t ctx [wid] "Give me all your money." - T.unpack err `shouldContain` errMsg403WrongPass - c `shouldBe` ExitFailure 1 - out `shouldBe` mempty + liftIO $ do + T.unpack err `shouldContain` errMsg403WrongPass + c `shouldBe` ExitFailure 1 + out `shouldBe` mempty where title = "ADDRESS_CREATE_03 - Cannot create a random address with wrong passphrase" @@ -256,19 +266,20 @@ scenario_ADDRESS_CREATE_04 , KnownCommand t ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_04 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_04 = it title $ \ctx -> runResourceT @IO $ do w <- emptyRandomWallet ctx let wid = T.unpack (w ^. walletId) (c, out, err) <- createAddressViaCLI @t ctx [wid] (T.unpack fixturePassphrase) - T.unpack err `shouldContain` cmdOk - c `shouldBe` ExitSuccess - addr <- expectValidJSON (Proxy @(ApiAddress n)) (T.unpack out) + liftIO $ do + T.unpack err `shouldContain` cmdOk + c `shouldBe` ExitSuccess + addr <- expectValidJSON (Proxy @(ApiAddress n)) (T.unpack out) - (Exit cl, Stdout outl, Stderr errl) <- listAddressesViaCLI @t ctx [wid] - errl `shouldBe` cmdOk - cl `shouldBe` ExitSuccess - j <- expectValidJSON (Proxy @[ApiAddress n]) outl - expectCliListField 0 id (`shouldBe` addr) j + (Exit cl, Stdout outl, Stderr errl) <- listAddressesViaCLI @t ctx [wid] + errl `shouldBe` cmdOk + cl `shouldBe` ExitSuccess + j <- expectValidJSON (Proxy @[ApiAddress n]) outl + expectCliListField 0 id (`shouldBe` addr) j where title = "CLI_ADDRESS_CREATE_04 - Can list address after creating it" @@ -279,15 +290,16 @@ scenario_ADDRESS_CREATE_05 , KnownCommand t ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_05 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_05 = it title $ \ctx -> runResourceT @IO $ do w <- emptyRandomWallet ctx let wid = T.unpack (w ^. walletId) let args = [ wid, "--address-index", "2147483662" ] (c, out, err) <- createAddressViaCLI @t ctx args (T.unpack fixturePassphrase) - T.unpack err `shouldContain` cmdOk - c `shouldBe` ExitSuccess - j <- expectValidJSON (Proxy @(ApiAddress n)) (T.unpack out) - verify j [ expectCliField #state (`shouldBe` ApiT Unused) ] + liftIO $ do + T.unpack err `shouldContain` cmdOk + c `shouldBe` ExitSuccess + j <- expectValidJSON (Proxy @(ApiAddress n)) (T.unpack out) + verify j [ expectCliField #state (`shouldBe` ApiT Unused) ] where title = "CLI_ADDRESS_CREATE_05 - Can create an address and specify the index" @@ -298,18 +310,19 @@ scenario_ADDRESS_CREATE_06 , KnownCommand t ) => SpecWith (Context t) -scenario_ADDRESS_CREATE_06 = it title $ \ctx -> do +scenario_ADDRESS_CREATE_06 = it title $ \ctx -> runResourceT @IO $ do w <- emptyRandomWallet ctx let wid = T.unpack (w ^. walletId) let args = [ wid, "--address-index", "2147483662" ] let createTheSameAddr = createAddressViaCLI @t ctx args (T.unpack fixturePassphrase) - (c, _, _) <- createTheSameAddr - c `shouldBe` ExitSuccess + liftIO $ do + (c, _, _) <- createTheSameAddr + c `shouldBe` ExitSuccess - (c2, out2, err2) <- createTheSameAddr - T.unpack err2 `shouldContain` "I already know of such address." - c2 `shouldBe` ExitFailure 1 - out2 `shouldBe` mempty + (c2, out2, err2) <- createTheSameAddr + T.unpack err2 `shouldContain` "I already know of such address." + c2 `shouldBe` ExitFailure 1 + out2 `shouldBe` mempty where title = "CLI_ADDRESS_CREATE_06 - Cannot create an address that already exists" @@ -322,14 +335,15 @@ scenario_ADDRESS_CREATE_07 => String -> String -> SpecWith (Context t) -scenario_ADDRESS_CREATE_07 index expectedMsg = it index $ \ctx -> do +scenario_ADDRESS_CREATE_07 index expectedMsg = it index $ \ctx -> runResourceT @IO $ do w <- emptyRandomWallet ctx let wid = T.unpack (w ^. walletId) let args = [ wid, "--address-index", index ] (c, out, err) <- createAddressViaCLI @t ctx args (T.unpack fixturePassphrase) - T.unpack err `shouldContain` expectedMsg - c `shouldBe` ExitFailure 1 - out `shouldBe` mempty + liftIO $ do + T.unpack err `shouldContain` expectedMsg + c `shouldBe` ExitFailure 1 + out `shouldBe` mempty scenario_ADDRESS_IMPORT_01 :: forall (n :: NetworkDiscriminant) t. @@ -339,13 +353,14 @@ scenario_ADDRESS_IMPORT_01 , KnownCommand t ) => SpecWith (Context t) -scenario_ADDRESS_IMPORT_01 = it title $ \ctx -> do +scenario_ADDRESS_IMPORT_01 = it title $ \ctx -> runResourceT @IO $ do (w, mw) <- emptyRandomWalletMws ctx let wid = T.unpack (w ^. walletId) let addr = T.unpack $ encodeAddress @n $ randomAddresses @n mw !! 42 (Exit c, Stdout _out, Stderr err) <- importAddressViaCLI @t ctx [wid, addr] - c `shouldBe` ExitSuccess - err `shouldContain` cmdOk + liftIO $ do + c `shouldBe` ExitSuccess + err `shouldContain` cmdOk where title = "CLI_ADDRESS_IMPORT_01 - I can import an address from my wallet" @@ -357,13 +372,14 @@ scenario_ADDRESS_IMPORT_02 , KnownCommand t ) => SpecWith (Context t) -scenario_ADDRESS_IMPORT_02 = it title $ \ctx -> do +scenario_ADDRESS_IMPORT_02 = it title $ \ctx -> runResourceT @IO $ do (w, mw) <- emptyIcarusWalletMws ctx let wid = T.unpack (w ^. walletId) let addr = T.unpack $ encodeAddress @n $ icarusAddresses @n mw !! 42 (Exit c, Stdout _out, Stderr err) <- importAddressViaCLI @t ctx [wid, addr] - c `shouldBe` ExitFailure 1 - err `shouldContain` errMsg403NotAByronWallet + liftIO $ do + c `shouldBe` ExitFailure 1 + err `shouldContain` errMsg403NotAByronWallet where title = "CLI_ADDRESS_IMPORT_02 - I can't import an address on an Icarus wallets" @@ -375,12 +391,13 @@ scenario_ADDRESS_IMPORT_03 , KnownCommand t ) => SpecWith (Context t) -scenario_ADDRESS_IMPORT_03 = it title $ \ctx -> do +scenario_ADDRESS_IMPORT_03 = it title $ \ctx -> runResourceT @IO $ do w <- emptyRandomWallet ctx let wid = T.unpack (w ^. walletId) let addr = "💩" (Exit c, Stdout _out, Stderr err) <- importAddressViaCLI @t ctx [wid, addr] - c `shouldBe` ExitFailure 1 - err `shouldBe` "Unable to decode Address: not a valid Base58 encoded string.\n" + liftIO $ do + c `shouldBe` ExitFailure 1 + err `shouldBe` "Unable to decode Address: not a valid Base58 encoded string.\n" where title = "CLI_ADDRESS_IMPORT_03 - I can't import a gibberish address" diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Byron/Wallets.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Byron/Wallets.hs index b17f0d6c7fb..34f9d633956 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Byron/Wallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Byron/Wallets.hs @@ -21,6 +21,10 @@ import Cardano.Wallet.Primitive.SyncProgress ( SyncProgress (..) ) import Control.Monad ( forM_ ) +import Control.Monad.IO.Class + ( liftIO ) +import Control.Monad.Trans.Resource + ( ResourceT, runResourceT ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.Maybe @@ -90,49 +94,50 @@ spec = describe "BYRON_CLI_WALLETS" $ do let matrix = [ ("random", genMnemonics M12) , ("icarus", genMnemonics M15) ] - forM_ matrix $ \(style, genM) -> it style $ \ctx -> do - mnemonic <- genM + forM_ matrix $ \(style, genM) -> it style $ \ctx -> runResourceT $ do + mnemonic <- liftIO genM let args = [ "Name of the wallet" , "--wallet-style", style ] --create - (c, out, err) <- createWalletViaCLI @t ctx + (c, out, err) <- createWalletViaCLI @t @_ @(ResourceT IO) ctx args (unwords $ T.unpack <$> mnemonic) "\n" "secure-passphrase" - T.unpack err `shouldContain` cmdOk - c `shouldBe` ExitSuccess - j <- expectValidJSON (Proxy @ApiByronWallet) out - let wid = T.unpack $ j ^. walletId - --delete - (Exit cd, Stdout outd, Stderr errd) <- deleteWalletViaCLI @t ctx wid - outd`shouldBe` "\n" - cd `shouldBe` ExitSuccess - errd `shouldContain` cmdOk - --not available - (Exit c2, Stdout out2, Stderr err2) <- getWalletViaCLI @t ctx wid - out2 `shouldBe` mempty - c2 `shouldBe` ExitFailure 1 - err2 `shouldContain` errMsg404NoWallet (T.pack wid) - --re-create - (c3, out3, err3) <- createWalletViaCLI @t ctx - args (unwords $ T.unpack <$> mnemonic) - "\n" "secure-passphrase-restored" - c3 `shouldBe` ExitSuccess - T.unpack err3 `shouldContain` cmdOk - jr <- expectValidJSON (Proxy @ApiByronWallet) out3 - verify jr [ expectCliField walletId (`shouldBe` T.pack wid) ] - --re-create again? No! - (c4, out4, err4) <- createWalletViaCLI @t ctx - args (unwords $ T.unpack <$> mnemonic) - "\n" "secure-passphrase-restored-again" - c4 `shouldBe` ExitFailure 1 - T.unpack err4 `shouldContain` (errMsg409WalletExists wid) - out4 `shouldBe` mempty + liftIO $ do + T.unpack err `shouldContain` cmdOk + c `shouldBe` ExitSuccess + j <- expectValidJSON (Proxy @ApiByronWallet) out + let wid = T.unpack $ j ^. walletId + --delete + (Exit cd, Stdout outd, Stderr errd) <- deleteWalletViaCLI @t ctx wid + outd`shouldBe` "\n" + cd `shouldBe` ExitSuccess + errd `shouldContain` cmdOk + --not available + (Exit c2, Stdout out2, Stderr err2) <- getWalletViaCLI @t ctx wid + out2 `shouldBe` mempty + c2 `shouldBe` ExitFailure 1 + err2 `shouldContain` errMsg404NoWallet (T.pack wid) + --re-create + (c3, out3, err3) <- createWalletViaCLI @t ctx + args (unwords $ T.unpack <$> mnemonic) + "\n" "secure-passphrase-restored" + c3 `shouldBe` ExitSuccess + T.unpack err3 `shouldContain` cmdOk + jr <- expectValidJSON (Proxy @ApiByronWallet) out3 + verify jr [ expectCliField walletId (`shouldBe` T.pack wid) ] + --re-create again? No! + (c4, out4, err4) <- createWalletViaCLI @t ctx + args (unwords $ T.unpack <$> mnemonic) + "\n" "secure-passphrase-restored-again" + c4 `shouldBe` ExitFailure 1 + T.unpack err4 `shouldContain` (errMsg409WalletExists wid) + out4 `shouldBe` mempty describe "CLI_BYRON_RESTORE_01, CLI_BYRON_GET_01, CLI_BYRON_LIST_01 -\ \Restore a wallet" $ do - let scenarioSuccess style mnemonic ctx = do + let scenarioSuccess style mnemonic ctx = runResourceT @IO $ do let name = "Name of the wallet" let args = [ name @@ -151,10 +156,11 @@ spec = describe "BYRON_CLI_WALLETS" $ do (c, out, err) <- createWalletViaCLI @t ctx args (unwords $ T.unpack <$> mnemonic) "\n" "secure-passphrase" - T.unpack err `shouldContain` cmdOk - c `shouldBe` ExitSuccess + liftIO $ do + T.unpack err `shouldContain` cmdOk + c `shouldBe` ExitSuccess j <- expectValidJSON (Proxy @ApiByronWallet) out - verify j expectations + liftIO $ verify j expectations let wid = T.unpack $ j ^. walletId eventually "wallet is available and ready" $ do @@ -173,7 +179,7 @@ spec = describe "BYRON_CLI_WALLETS" $ do length jl `shouldBe` 1 expectCliListField 0 walletId (`shouldBe` T.pack wid) jl - let scenarioFailure style mnemonic ctx = do + let scenarioFailure style mnemonic ctx = runResourceT @IO $ do let args = [ "The wallet that didn't exist" , "--wallet-style", style @@ -181,9 +187,10 @@ spec = describe "BYRON_CLI_WALLETS" $ do (c, out, err) <- createWalletViaCLI @t ctx args (unwords $ T.unpack <$> mnemonic) "\n" "secure-passphrase" - T.unpack err `shouldContain` errMsg400NumberOfWords - c `shouldBe` ExitFailure 1 - out `shouldBe` mempty + liftIO $ do + T.unpack err `shouldContain` errMsg400NumberOfWords + c `shouldBe` ExitFailure 1 + out `shouldBe` mempty let it' style genMnemonicIO test = do mnemonic <- runIO genMnemonicIO @@ -236,80 +243,89 @@ spec = describe "BYRON_CLI_WALLETS" $ do , ( "Wildcards passphrase", wildcardsWalletName ) ] forM_ matrix $ \(title, passphrase) -> it title $ - \ctx -> do + \ctx -> runResourceT @IO $ do let args = [ "Name of the wallet" , "--wallet-style", "random" ] - mnemonic <- genMnemonics M12 + mnemonic <- liftIO $ genMnemonics M12 (c, out, err) <- createWalletViaCLI @t ctx args (unwords $ T.unpack <$> mnemonic) "\n" (T.unpack passphrase) - T.unpack err `shouldContain` cmdOk - _ <- expectValidJSON (Proxy @ApiByronWallet) out - c `shouldBe` ExitSuccess + liftIO $ do + T.unpack err `shouldContain` cmdOk + _ <- expectValidJSON (Proxy @ApiByronWallet) out + c `shouldBe` ExitSuccess it "CLI_BYRON_UPDATE_NAME_01 - Update names of wallets" $ \ctx -> forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ - \emptyByronWallet -> do + \emptyByronWallet -> runResourceT @IO $ do wid <- fmap (T.unpack . view walletId) (emptyByronWallet ctx) - let updatedName = "Name is updated" - (Exit c, Stdout out, Stderr err) <- - updateWalletNameViaCLI @t ctx [wid, updatedName] - c `shouldBe` ExitSuccess - err `shouldBe` cmdOk - ju <- expectValidJSON (Proxy @ApiByronWallet) out - expectCliField - (#name . #getApiT . #getWalletName) - (`shouldBe` T.pack updatedName) ju + liftIO $ do + let updatedName = "Name is updated" + (Exit c, Stdout out, Stderr err) <- + updateWalletNameViaCLI @t ctx [wid, updatedName] + c `shouldBe` ExitSuccess + err `shouldBe` cmdOk + ju <- expectValidJSON (Proxy @ApiByronWallet) out + expectCliField + (#name . #getApiT . #getWalletName) + (`shouldBe` T.pack updatedName) ju it "CLI_BYRON_UPDATE_NAME_02 - When updated name too long" $ \ctx -> forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ - \emptyByronWallet -> do + \emptyByronWallet -> runResourceT @IO $ do wid <- fmap (T.unpack . view walletId) (emptyByronWallet ctx) - let updatedName = replicate 500 'o' - (Exit c, Stdout out, Stderr err) <- - updateWalletNameViaCLI @t ctx [wid, updatedName] - c `shouldBe` ExitFailure 1 - err `shouldContain` "name is too long: expected at most 255 characters" - out `shouldBe` mempty + liftIO $ do + let updatedName = replicate 500 'o' + (Exit c, Stdout out, Stderr err) <- + updateWalletNameViaCLI @t ctx [wid, updatedName] + c `shouldBe` ExitFailure 1 + err `shouldContain` "name is too long: expected at most 255 characters" + out `shouldBe` mempty it "CLI_BYRON_UTXO_01 - Wallet's inactivity is reflected in utxo" $ \ctx -> - forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> do + forM_ [ emptyRandomWallet, emptyIcarusWallet ] + $ \emptyByronWallet -> runResourceT @IO $ do wid <- fmap (T.unpack . view walletId) (emptyByronWallet ctx) - (Exit c, Stdout o, Stderr e) <- getWalletUtxoStatisticsViaCLI @t ctx wid - c `shouldBe` ExitSuccess - e `shouldBe` cmdOk - utxoStats <- expectValidJSON (Proxy @ApiUtxoStatistics) o - expectWalletUTxO [] (Right utxoStats) + liftIO $ do + (Exit c, Stdout o, Stderr e) <- getWalletUtxoStatisticsViaCLI @t ctx wid + c `shouldBe` ExitSuccess + e `shouldBe` cmdOk + utxoStats <- expectValidJSON (Proxy @ApiUtxoStatistics) o + expectWalletUTxO [] (Right utxoStats) it "CLI_BYRON_UPDATE_PASS_01 - change passphrase" $ \ctx -> - forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> do + forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ + \emptyByronWallet -> runResourceT @IO $ do wid <- fmap (T.unpack . view walletId) (emptyByronWallet ctx) - Stdout out <- getWalletViaCLI @t ctx wid - expectValidJSON (Proxy @ApiByronWallet) out - >>= flip verify [ expectCliField #passphrase (`shouldSatisfy` isJust) ] - let oldPass = T.unpack fixturePassphrase - let newPass = "cardano-wallet-new-pass" - (c, o, e) <- - updateWalletPassphraseViaCLI @t ctx wid oldPass newPass newPass - c `shouldBe` ExitSuccess - o `shouldBe` "\n" - T.unpack e `shouldContain` cmdOk + liftIO $ do + Stdout out <- getWalletViaCLI @t ctx wid + expectValidJSON (Proxy @ApiByronWallet) out + >>= flip verify [ expectCliField #passphrase (`shouldSatisfy` isJust) ] + let oldPass = T.unpack fixturePassphrase + let newPass = "cardano-wallet-new-pass" + (c, o, e) <- + updateWalletPassphraseViaCLI @t ctx wid oldPass newPass newPass + c `shouldBe` ExitSuccess + o `shouldBe` "\n" + T.unpack e `shouldContain` cmdOk it "CLI_BYRON_UPDATE_PASS_02 - Old passphrase incorrect" $ \ctx -> - forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> do + forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ + \emptyByronWallet -> runResourceT @IO $ do wid <- fmap (T.unpack . view walletId) (emptyByronWallet ctx) - Stdout out <- getWalletViaCLI @t ctx wid - expectValidJSON (Proxy @ApiByronWallet) out - >>= flip verify [ expectCliField #passphrase (`shouldSatisfy` isJust) ] - let oldPass = "incorrect-passphrase" - let newPass = "cardano-wallet-new-pass" - (c, o, e) <- - updateWalletPassphraseViaCLI @t ctx wid oldPass newPass newPass - c `shouldBe` ExitFailure 1 - o `shouldBe` mempty - T.unpack e `shouldContain` errMsg403WrongPass + liftIO $ do + Stdout out <- getWalletViaCLI @t ctx wid + expectValidJSON (Proxy @ApiByronWallet) out + >>= flip verify [ expectCliField #passphrase (`shouldSatisfy` isJust) ] + let oldPass = "incorrect-passphrase" + let newPass = "cardano-wallet-new-pass" + (c, o, e) <- + updateWalletPassphraseViaCLI @t ctx wid oldPass newPass newPass + c `shouldBe` ExitFailure 1 + o `shouldBe` mempty + T.unpack e `shouldContain` errMsg403WrongPass describe "CLI_BYRON_UPDATE_PASS_03 - Pass length incorrect" $ do let minLength = passphraseMinLength (Proxy @"raw") @@ -325,14 +341,15 @@ spec = describe "BYRON_CLI_WALLETS" $ do , ("new pass too short", passOK, passTooShort, errMsgTooShort) , ("new pass too long", passOK, passTooLong, errMsgTooLong) ] - forM_ matrix $ \(title, oldPass, newPass, errMsg) -> it title $ \ctx -> do + forM_ matrix $ \(title, oldPass, newPass, errMsg) -> it title $ \ctx -> runResourceT @IO $ do forM_ [ emptyRandomWallet, emptyIcarusWallet ] $ \emptyByronWallet -> do wid <- fmap (T.unpack . view walletId) (emptyByronWallet ctx) - Stdout out <- getWalletViaCLI @t ctx wid - expectValidJSON (Proxy @ApiByronWallet) out - >>= flip verify [ expectCliField #passphrase (`shouldSatisfy` isJust) ] - (c, o, e) <- - updateWalletPassphraseViaCLI @t ctx wid oldPass newPass newPass - T.unpack e `shouldContain` errMsg - c `shouldBe` ExitFailure 1 - o `shouldBe` mempty + liftIO $ do + Stdout out <- getWalletViaCLI @t ctx wid + expectValidJSON (Proxy @ApiByronWallet) out + >>= flip verify [ expectCliField #passphrase (`shouldSatisfy` isJust) ] + (c, o, e) <- + updateWalletPassphraseViaCLI @t ctx wid oldPass newPass newPass + T.unpack e `shouldContain` errMsg + c `shouldBe` ExitFailure 1 + o `shouldBe` mempty diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Miscellaneous.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Miscellaneous.hs index 246ec4f8579..1bf4b08fdb9 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Miscellaneous.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Miscellaneous.hs @@ -28,8 +28,8 @@ import qualified Data.List as L spec :: forall t. KnownCommand t => SpecWith () spec = describe "COMMON_CLI_MISC" $ do - it "CLI_VERSION - cardano-wallet shows version" $ do - (Exit c, Stdout out) <- cardanoWalletCLI @t ["version"] + it "CLI_VERSION - cardano-wallet shows version" $ do + (Exit c, Stdout out) <- cardanoWalletCLI @t @_ @IO ["version"] let v = L.dropWhileEnd (== '\n') out v `shouldContain` (showVersion version <> " (git revision: " ) c `shouldBe` ExitSuccess @@ -100,14 +100,14 @@ spec = describe "COMMON_CLI_MISC" $ do , "network information --port" ] forM_ badArgs $ \args -> it args $ \_ -> do - (Exit c, Stdout o, Stderr e) <- cardanoWalletCLI @t $ words args + (Exit c, Stdout o, Stderr e) <- cardanoWalletCLI @t @_ @IO $ words args c `shouldBe` ExitFailure 1 o `shouldBe` "" e `shouldContain` "Usage:" describe "CLI_HELP - cardano-wallet shows help with" $ do let test option = it option $ do - (Exit c, Stdout o, Stderr e) <- cardanoWalletCLI @t [option] + (Exit c, Stdout o, Stderr e) <- cardanoWalletCLI @t @_ @IO [option] e `shouldBe` "" o `shouldContain` "Usage:" o `shouldContain` "Available options:" diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Addresses.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Addresses.hs index a8b90246301..dc8675164d0 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Addresses.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Addresses.hs @@ -20,6 +20,8 @@ import Cardano.Wallet.Primitive.Types ( AddressState (..) ) import Control.Monad ( forM_ ) +import Control.Monad.Trans.Resource + ( ResourceT, runResourceT ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.Proxy @@ -68,7 +70,7 @@ spec :: forall n t. ) => SpecWith (Context t) spec = describe "SHELLEY_CLI_ADDRESSES" $ do - it "ADDRESS_LIST_01 - Can list addresses - default poolGap" $ \ctx -> do + it "ADDRESS_LIST_01 - Can list addresses - default poolGap" $ \ctx -> runResourceT $ do let g = fromIntegral $ getAddressPoolGap defaultAddressPoolGap walId <- emptyWallet' ctx (Exit c, Stdout out, Stderr err) <- listAddressesViaCLI @t ctx [walId] @@ -80,7 +82,7 @@ spec = describe "SHELLEY_CLI_ADDRESSES" $ do expectCliListField addrNum (#state . #getApiT) (`shouldBe` Unused) json - it "ADDRESS_LIST_01 - Can list addresses - non-default poolGap" $ \ctx -> do + it "ADDRESS_LIST_01 - Can list addresses - non-default poolGap" $ \ctx -> runResourceT $ do let addrPoolGap = 60 walId <- emptyWalletWith' ctx ("This is Wallet, OK?", "cardano-wallet", addrPoolGap) @@ -93,7 +95,7 @@ spec = describe "SHELLEY_CLI_ADDRESSES" $ do expectCliListField addrNum (#state . #getApiT) (`shouldBe` Unused) json - it "ADDRESS_LIST_02 - Can filter used and unused addresses" $ \ctx -> do + it "ADDRESS_LIST_02 - Can filter used and unused addresses" $ \ctx -> runResourceT $ do let g = fromIntegral $ getAddressPoolGap defaultAddressPoolGap walId <- fixtureWallet' ctx (Exit c1, Stdout o1, Stderr e1) @@ -116,7 +118,7 @@ spec = describe "SHELLEY_CLI_ADDRESSES" $ do addrNum (#state . #getApiT) (`shouldBe` Unused) j2 it "ADDRESS_LIST_02 - Shows nothing when there are no used addresses" - $ \ctx -> do + $ \ctx -> runResourceT $ do walId <- emptyWallet' ctx (Exit c1, Stdout o1, Stderr e1) <- listAddressesViaCLI @t ctx ["--state", "used", walId] @@ -147,7 +149,7 @@ spec = describe "SHELLEY_CLI_ADDRESSES" $ do , "44444444" , "*" ] - forM_ filters $ \fil -> it ("--state=" <> fil) $ \ctx -> do + forM_ filters $ \fil -> it ("--state=" <> fil) $ \ctx -> runResourceT $ do walId <- emptyWallet' ctx (Exit c, Stdout o, Stderr e) <- listAddressesViaCLI @t ctx ["--state", fil, walId] @@ -157,7 +159,7 @@ spec = describe "SHELLEY_CLI_ADDRESSES" $ do c `shouldBe` ExitFailure 1 o `shouldBe` "" - it "ADDRESS_LIST_03 - Generates new address pool gap" $ \ctx -> do + it "ADDRESS_LIST_03 - Generates new address pool gap" $ \ctx -> runResourceT $ do let initPoolGap = 10 wSrc <- fixtureWallet' ctx wDest <- emptyWalletWith ctx ("Wallet", "cardano-wallet", initPoolGap) @@ -201,7 +203,7 @@ spec = describe "SHELLEY_CLI_ADDRESSES" $ do addrNum (#state . #getApiT) (`shouldBe` Unused) j1 describe "ADDRESS_LIST_04 - False wallet ids" $ do - forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> do + forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> runResourceT $ do (Exit c, Stdout o, Stderr e) <- listAddressesViaCLI @t ctx [walId] o `shouldBe` "" c `shouldBe` ExitFailure 1 @@ -212,7 +214,7 @@ spec = describe "SHELLEY_CLI_ADDRESSES" $ do e `shouldContain` "wallet id should be a hex-encoded string of 40 characters" - it "ADDRESS_LIST_04 - 'almost' valid walletId" $ \ctx -> do + it "ADDRESS_LIST_04 - 'almost' valid walletId" $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx (Exit c, Stdout o, Stderr e) <- listAddressesViaCLI @t ctx [wid ++ "0"] e `shouldContain` @@ -220,7 +222,7 @@ spec = describe "SHELLEY_CLI_ADDRESSES" $ do o `shouldBe` "" c `shouldBe` ExitFailure 1 - it "ADDRESS_LIST_04 - Deleted wallet" $ \ctx -> do + it "ADDRESS_LIST_04 - Deleted wallet" $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx Exit d <- deleteWalletViaCLI @t ctx wid d `shouldBe` ExitSuccess @@ -230,7 +232,7 @@ spec = describe "SHELLEY_CLI_ADDRESSES" $ do o `shouldBe` "" c `shouldBe` ExitFailure 1 - it "BYRON_ADDRESS_LIST - Byron wallet on Shelley CLI" $ \ctx -> do + it "BYRON_ADDRESS_LIST - Byron wallet on Shelley CLI" $ \ctx -> runResourceT $ do wid <- emptyRandomWallet' ctx (Exit c, Stdout o, Stderr e) <- listAddressesViaCLI @t ctx [wid] e `shouldContain` errMsg404NoWallet (T.pack wid) @@ -238,15 +240,15 @@ spec = describe "SHELLEY_CLI_ADDRESSES" $ do c `shouldBe` ExitFailure 1 where - emptyRandomWallet' :: Context t -> IO String + emptyRandomWallet' :: Context t -> ResourceT IO String emptyRandomWallet' = fmap (T.unpack . view walletId) . emptyRandomWallet - emptyWallet' :: Context t -> IO String + emptyWallet' :: Context t -> ResourceT IO String emptyWallet' = fmap (T.unpack . view walletId) . emptyWallet - emptyWalletWith' :: Context t -> (Text, Text, Int) -> IO String + emptyWalletWith' :: Context t -> (Text, Text, Int) -> ResourceT IO String emptyWalletWith' ctx (name, pass, pg) = fmap (T.unpack . view walletId) (emptyWalletWith ctx (name, pass, pg)) - fixtureWallet' :: Context t -> IO String + fixtureWallet' :: Context t -> ResourceT IO String fixtureWallet' = fmap (T.unpack . view walletId) . fixtureWallet diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/HWWallets.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/HWWallets.hs index f516ed8ca7e..6b5bfa6a0b6 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/HWWallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/HWWallets.hs @@ -29,6 +29,8 @@ import Cardano.Wallet.Primitive.Types ( AddressState (..) ) import Control.Monad ( forM_ ) +import Control.Monad.Trans.Resource + ( ResourceT, runResourceT ) import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.Proxy @@ -92,7 +94,7 @@ spec :: forall n t. ) => SpecWith (Context t) spec = describe "SHELLEY_CLI_HW_WALLETS" $ do - it "HW_WALLETS_01x - Restoration from account public key preserves funds" $ \ctx -> do + it "HW_WALLETS_01x - Restoration from account public key preserves funds" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx -- create a wallet @@ -156,7 +158,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do ] describe "HW_WALLETS_03 - Cannot do operations requiring private key" $ do - it "Cannot send tx" $ \ctx -> do + it "Cannot send tx" $ \ctx -> runResourceT $ do -- create wallet from pubKey with funds (w, mnemonics) <- fixtureWalletWithMnemonics ctx let pubKey = T.unpack $ pubKeyFromMnemonics mnemonics @@ -185,7 +187,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do out `shouldBe` "" c `shouldBe` ExitFailure 1 - it "Cannot update pass" $ \ctx -> do + it "Cannot update pass" $ \ctx -> runResourceT $ do w <- emptyWalletFromPubKeyViaCLI ctx restoredWalletName let pass = "cardano-wallet" @@ -198,7 +200,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do exitCode `shouldBe` ExitFailure 1 describe "HW_WALLETS_04 - Can manage HW wallet the same way as others" $ do - it "Can update name" $ \ctx -> do + it "Can update name" $ \ctx -> runResourceT $ do w <- emptyWalletFromPubKeyViaCLI ctx restoredWalletName -- can update wallet name @@ -212,7 +214,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do expectCliField (#name . #getApiT . #getWalletName) (`shouldBe` n) j - it "Can get tx fee" $ \ctx -> do + it "Can get tx fee" $ \ctx -> runResourceT $ do -- create wallet from pubKey with funds (w, mnemonics) <- fixtureWalletWithMnemonics ctx let pubKey = T.unpack $ pubKeyFromMnemonics mnemonics @@ -243,7 +245,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do ] code `shouldBe` ExitSuccess - it "Can delete" $ \ctx -> do + it "Can delete" $ \ctx -> runResourceT $ do w <- emptyWalletFromPubKeyViaCLI ctx restoredWalletName (Exit cd, Stdout od, Stderr ed) <- deleteWalletViaCLI @t ctx $ T.unpack (w ^. walletId) @@ -251,7 +253,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do ed `shouldContain` cmdOk od `shouldBe` "\n" - it "Can see utxo" $ \ctx -> do + it "Can see utxo" $ \ctx -> runResourceT $ do w <- emptyWalletFromPubKeyViaCLI ctx restoredWalletName (Exit c, Stdout o, Stderr e) <- getWalletUtxoStatisticsViaCLI @t ctx $ T.unpack (w ^. walletId) @@ -260,7 +262,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do utxoStats <- expectValidJSON (Proxy @ApiUtxoStatistics) o expectWalletUTxO [] (Right utxoStats) - it "Can list addresses" $ \ctx -> do + it "Can list addresses" $ \ctx -> runResourceT $ do w <- emptyWalletFromPubKeyViaCLI ctx restoredWalletName let g = fromIntegral $ getAddressPoolGap defaultAddressPoolGap @@ -274,7 +276,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do expectCliListField addrNum (#state . #getApiT) (`shouldBe` Unused) json - it "Can have address pool gap" $ \ctx -> do + it "Can have address pool gap" $ \ctx -> runResourceT $ do Stdout m <- generateMnemonicsViaCLI @t [] let accXPub = pubKeyFromMnemonics' (words m) let addrPoolGap = 55 -- arbitrary but known @@ -292,7 +294,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do (#addressPoolGap . #getApiT . #getAddressPoolGap) (`shouldBe` addrPoolGap) j - it "Can list transactions" $ \ctx -> do + it "Can list transactions" $ \ctx -> runResourceT $ do w <- emptyWalletFromPubKeyViaCLI ctx restoredWalletName (Exit code, Stdout out, Stderr err) <- @@ -303,7 +305,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do code `shouldBe` ExitSuccess describe "HW_WALLETS_05 - Wallet from pubKey is available" $ do - it "The same account and mnemonic wallet can live side-by-side" $ \ctx -> do + it "The same account and mnemonic wallet can live side-by-side" $ \ctx -> runResourceT $ do Stdout m <- generateMnemonicsViaCLI @t [] let pubKeyWalName = "pub key wallet" let mnemonicWalName = "mnemonic wallet" @@ -337,12 +339,12 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do describe "HW_WALLETS_06 - Test parameters" $ do describe "Wallet names valid" $ do - forM_ walletNames $ \(title, n) -> it title $ \ctx -> do + forM_ walletNames $ \(title, n) -> it title $ \ctx -> runResourceT $ do j <- emptyWalletFromPubKeyViaCLI ctx n expectCliField (#name . #getApiT . #getWalletName) (`shouldBe` T.pack n) j describe "Wallet names invalid" $ do - forM_ walletNamesInvalid $ \(name, expects) -> it expects $ \ctx -> do + forM_ walletNamesInvalid $ \(name, expects) -> it expects $ \ctx -> runResourceT $ do Stdout m <- generateMnemonicsViaCLI @t [] let accXPub = pubKeyFromMnemonics' (words m) (Exit c, Stdout o, Stderr e) <- @@ -352,7 +354,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do o `shouldBe` mempty describe "Pub Key invalid" $ do let pubKeysInvalid = ["", "1", replicate 128 'ś', replicate 129 '1'] - forM_ pubKeysInvalid $ \key -> it ("Pub key: " ++ key) $ \ctx -> do + forM_ pubKeysInvalid $ \key -> it ("Pub key: " ++ key) $ \ctx -> runResourceT $ do (Exit c, Stdout o, Stderr e) <- createWalletFromPublicKeyViaCLI @t ctx [restoredWalletName, key] c `shouldBe` ExitFailure 1 @@ -365,7 +367,7 @@ spec = describe "SHELLEY_CLI_HW_WALLETS" $ do let addrPoolMax = fromIntegral @_ @Int $ getAddressPoolGap maxBound let poolGapsInvalid = [-1, 0, addrPoolMin - 1, addrPoolMax + 1] - forM_ poolGapsInvalid $ \pGap -> it ("Pool gap: " ++ show pGap) $ \ctx -> do + forM_ poolGapsInvalid $ \pGap -> it ("Pool gap: " ++ show pGap) $ \ctx -> runResourceT $ do Stdout m <- generateMnemonicsViaCLI @t [] let accXPub = pubKeyFromMnemonics' (words m) (Exit c, Stdout o, Stderr e) <- @@ -383,7 +385,7 @@ emptyWalletFromPubKeyViaCLI :: forall t. (KnownCommand t) => Context t -> String - -> IO ApiWallet + -> ResourceT IO ApiWallet emptyWalletFromPubKeyViaCLI ctx name = do Stdout m <- generateMnemonicsViaCLI @t [] let accXPub = pubKeyFromMnemonics' (words m) diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs index c87b9041450..4909c98459a 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Transactions.hs @@ -33,6 +33,14 @@ import Cardano.Wallet.Primitive.Types ) import Control.Monad ( forM_, join ) +import Control.Monad.Catch + ( MonadCatch ) +import Control.Monad.Fail + ( MonadFail ) +import Control.Monad.IO.Class + ( MonadIO, liftIO ) +import Control.Monad.Trans.Resource + ( ResourceT, runResourceT ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.Generics.Product.Typed @@ -115,7 +123,7 @@ spec :: forall n t. , EncodeAddress n ) => SpecWith (Context t) spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do - it "TRANS_CREATE_01 - Can create transaction via CLI" $ \ctx -> do + it "TRANS_CREATE_01 - Can create transaction via CLI" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx @@ -153,7 +161,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do (#balance . #getApiT . #total) (`shouldBe` Quantity amt) ] - it "TRANS_CREATE_02 - Multiple Output Tx to single wallet via CLI" $ \ctx -> do + it "TRANS_CREATE_02 - Multiple Output Tx to single wallet via CLI" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx addr <- listAddresses @n ctx wDest @@ -173,7 +181,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do (c, out, err) <- postTransactionViaCLI @t ctx "cardano-wallet" args err `shouldBe` "Please enter your passphrase: **************\nOk.\n" txJson <- expectValidJSON (Proxy @(ApiTransaction n)) out - verify txJson + liftIO $ verify txJson [ expectCliField (#amount . #getQuantity) (between (feeMin + (2*amt), feeMax + (2*amt))) @@ -202,7 +210,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do (#balance . #getApiT . #total) (`shouldBe` Quantity (2*amt)) ] - it "TRANS_CREATE_04 - Wrong password" $ \ctx -> do + it "TRANS_CREATE_04 - Wrong password" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx addrs:_ <- listAddresses @n ctx wDest @@ -218,7 +226,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do c `shouldBe` ExitFailure 1 describe "TRANS_CREATE_05 - Invalid addresses" $ do - forM_ matrixInvalidAddrs $ \(title, addr, errMsg) -> it title $ \ctx -> do + forM_ matrixInvalidAddrs $ \(title, addr, errMsg) -> it title $ \ctx -> runResourceT $ do wSrc <- emptyWallet ctx let args = T.unpack <$> [ wSrc ^. walletId @@ -232,7 +240,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do c `shouldBe` ExitFailure 1 describe "TRANS_CREATE_06 - Invalid amount" $ do - forM_ matrixInvalidAmt $ \(title, amt, errMsg) -> it title $ \ctx -> do + forM_ matrixInvalidAmt $ \(title, amt, errMsg) -> it title $ \ctx -> runResourceT $ do wSrc <- emptyWallet ctx wDest <- emptyWallet ctx addrs:_ <- listAddresses @n ctx wDest @@ -249,7 +257,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do c `shouldBe` ExitFailure 1 describe "TRANS_CREATE_07 - False wallet ids" $ do - forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> do + forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> runResourceT $ do wDest <- emptyWallet ctx addrs:_ <- listAddresses @n ctx wDest let port = show $ ctx ^. typed @(Port "wallet") @@ -269,7 +277,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do err `shouldContain` "wallet id should be a \ \hex-encoded string of 40 characters" - it "TRANS_CREATE_07 - 'almost' valid walletId" $ \ctx -> do + it "TRANS_CREATE_07 - 'almost' valid walletId" $ \ctx -> runResourceT $ do wSrc <- emptyWallet ctx wDest <- emptyWallet ctx addrs:_ <- listAddresses @n ctx wDest @@ -286,27 +294,28 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do out `shouldBe` "" c `shouldBe` ExitFailure 1 - it "TRANS_CREATE_07 - Deleted wallet" $ \ctx -> do + it "TRANS_CREATE_07 - Deleted wallet" $ \ctx -> runResourceT $ do wSrc <- emptyWallet ctx Exit ex <- deleteWalletViaCLI @t ctx (T.unpack ( wSrc ^. walletId )) - ex `shouldBe` ExitSuccess + liftIO $ ex `shouldBe` ExitSuccess wDest <- emptyWallet ctx - addrs:_ <- listAddresses @n ctx wDest - let addr = encodeAddress @n (getApiT $ fst $ addrs ^. #id) - let port = T.pack $ show $ ctx ^. typed @(Port "wallet") - let args = T.unpack <$> - [ "transaction", "create", "--port", port - , wSrc ^. walletId, "--payment", T.pack (show minUTxOValue) <> "@" <> addr - ] - -- make sure CLI returns error before asking for passphrase - (Exit c, Stdout out, Stderr err) <- cardanoWalletCLI @t args - err `shouldContain` "I couldn't find a wallet with \ - \the given id: " ++ T.unpack ( wSrc ^. walletId ) - out `shouldBe` "" - c `shouldBe` ExitFailure 1 + liftIO $ do + addrs:_ <- listAddresses @n ctx wDest + let addr = encodeAddress @n (getApiT $ fst $ addrs ^. #id) + let port = T.pack $ show $ ctx ^. typed @(Port "wallet") + let args = T.unpack <$> + [ "transaction", "create", "--port", port + , wSrc ^. walletId, "--payment", T.pack (show minUTxOValue) <> "@" <> addr + ] + -- make sure CLI returns error before asking for passphrase + (Exit c, Stdout out, Stderr err) <- cardanoWalletCLI @t args + err `shouldContain` "I couldn't find a wallet with \ + \the given id: " ++ T.unpack ( wSrc ^. walletId ) + out `shouldBe` "" + c `shouldBe` ExitFailure 1 - it "TRANSMETA_CREATE_01 - Transaction with metadata via CLI" $ \ctx -> do + it "TRANSMETA_CREATE_01 - Transaction with metadata via CLI" $ \ctx -> runResourceT $ do (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx let amt = 10_000_000 let md = Just "{ \"1\": { \"string\": \"hello\" } }" @@ -338,7 +347,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do ] describe "TRANS_ESTIMATE_08 - Invalid addresses" $ do - forM_ matrixInvalidAddrs $ \(title, addr, errMsg) -> it title $ \ctx -> do + forM_ matrixInvalidAddrs $ \(title, addr, errMsg) -> it title $ \ctx -> runResourceT $ do wSrc <- emptyWallet ctx let args = T.unpack <$> [ wSrc ^. walletId @@ -351,7 +360,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do c `shouldBe` ExitFailure 1 describe "TRANS_ESTIMATE_09 - Invalid amount" $ do - forM_ matrixInvalidAmt $ \(title, amt, errMsg) -> it title $ \ctx -> do + forM_ matrixInvalidAmt $ \(title, amt, errMsg) -> it title $ \ctx -> runResourceT $ do wSrc <- emptyWallet ctx wDest <- emptyWallet ctx addrs:_ <- listAddresses @n ctx wDest @@ -377,7 +386,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do <> " in " <> show mOrder <> " order " - it title $ \ctx -> do + it title $ \ctx -> runResourceT $ do wallet <- emptyWallet ctx (Exit code, Stdout out, Stderr err) <- listTransactionsViaCLI @t ctx $ join @@ -390,7 +399,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do out `shouldBe` "[]\n" code `shouldBe` ExitSuccess - it "TRANS_LIST_01 - Can list Incoming and Outgoing transactions" $ \ctx -> do + it "TRANS_LIST_01 - Can list Incoming and Outgoing transactions" $ \ctx -> runResourceT $ do -- Make tx from fixtureWallet wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx @@ -439,7 +448,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do <> " in " <> show mOrder <> " order " - it title $ \ctx -> do + it title $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx (Exit code, Stdout out, Stderr err) <- listTransactionsViaCLI @t ctx $ join @@ -458,7 +467,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do out `shouldBe` mempty code `shouldBe` ExitFailure 1 - it "TRANS_LIST_03 - Can order results" $ \ctx -> do + it "TRANS_LIST_03 - Can order results" $ \ctx -> runResourceT $ do let a1 = Quantity $ sum $ replicate 10 minUTxOValue let a2 = Quantity $ sum $ replicate 10 (2 * minUTxOValue) w <- fixtureWalletWith @n ctx $ mconcat @@ -523,7 +532,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do , orderErr ) ] - forM_ queries $ \(q, errorMess) -> it (unwords q) $ \ctx -> do + forM_ queries $ \(q, errorMess) -> it (unwords q) $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx let args = wid : q (Exit code, Stdout out, Stderr err) <- @@ -532,7 +541,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do code `shouldBe` ExitFailure 1 err `shouldContain` errorMess - it "TRANS_LIST_04 - 'almost' valid walletId" $ \ctx -> do + it "TRANS_LIST_04 - 'almost' valid walletId" $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx let invalidWid = wid ++ "0" (Exit code, Stdout out, Stderr err) <- @@ -543,7 +552,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do code `shouldBe` ExitFailure 1 out `shouldBe` mempty - it "TRANS_LIST_04 - Deleted wallet" $ \ctx -> do + it "TRANS_LIST_04 - Deleted wallet" $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx Exit d <- deleteWalletViaCLI @t ctx wid d `shouldBe` ExitSuccess @@ -554,7 +563,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do c `shouldBe` ExitFailure 1 describe "TRANS_LIST_04 - False wallet ids" $ do - forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> do + forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> runResourceT $ do (Exit c, Stdout o, Stderr e) <- listTransactionsViaCLI @t ctx [walId] o `shouldBe` "" c `shouldBe` ExitFailure 1 @@ -567,7 +576,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do it "TRANS_LIST_RANGE_01 - \ \Transaction at time t is SELECTED by small ranges that cover it" $ - \ctx -> do + \ctx -> runResourceT $ do w <- fixtureWalletWith @n ctx [minUTxOValue] let walId = w ^. walletId t <- unsafeGetTransactionTime <$> listAllTransactions @n ctx w @@ -592,7 +601,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do it "TRANS_LIST_RANGE_02 - \ \Transaction at time t is NOT selected by range [t + 𝛿t, ...)" $ - \ctx -> do + \ctx -> runResourceT $ do w <- fixtureWalletWith @n ctx [minUTxOValue] let walId = w ^. walletId t <- unsafeGetTransactionTime <$> listAllTransactions @n ctx w @@ -607,7 +616,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do it "TRANS_LIST_RANGE_03 - \ \Transaction at time t is NOT selected by range (..., t - 𝛿t]" $ - \ctx -> do + \ctx -> runResourceT $ do w <- fixtureWalletWith @n ctx [minUTxOValue] let walId = w ^. walletId t <- unsafeGetTransactionTime <$> listAllTransactions @n ctx w @@ -620,7 +629,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do oJson2 <- expectValidJSON (Proxy @([ApiTransaction n])) o2 length <$> [oJson1, oJson2] `shouldSatisfy` all (== 0) - it "TRANS_GET_01 - Can get Incoming and Outgoing transaction" $ \ctx -> do + it "TRANS_GET_01 - Can get Incoming and Outgoing transaction" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx addr:_ <- listAddresses @n ctx wDest @@ -677,7 +686,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do , expectCliField (#status . #getApiT) (`shouldBe` InLedger) ] - it "TRANS_GET_02 - Deleted wallet" $ \ctx -> do + it "TRANS_GET_02 - Deleted wallet" $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx Exit d <- deleteWalletViaCLI @t ctx wid d `shouldBe` ExitSuccess @@ -688,7 +697,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do o `shouldBe` mempty c `shouldBe` ExitFailure 1 - it "TRANS_GET_03 - Using wrong transaction id" $ \ctx -> do + it "TRANS_GET_03 - Using wrong transaction id" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx addr:_ <- listAddresses @n ctx wDest @@ -715,7 +724,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do c2 `shouldBe` ExitFailure 1 - it "TRANS_DELETE_01 - Cannot forget pending transaction when not pending anymore via CLI" $ \ctx -> do + it "TRANS_DELETE_01 - Cannot forget pending transaction when not pending anymore via CLI" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx let wSrcId = T.unpack (wSrc ^. walletId) @@ -745,7 +754,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do out2 `shouldBe` "" c2 `shouldBe` ExitFailure 1 - it "TRANS_DELETE_03 - Cannot forget tx that is not found via CLI" $ \ctx -> do + it "TRANS_DELETE_03 - Cannot forget tx that is not found via CLI" $ \ctx -> runResourceT $ do wid <- fixtureWallet' ctx let txId = "3e6ec12da4414aa0781ff8afa9717ae53ee8cb4aa55d622f65bc62619a4f7b12" -- forget transaction @@ -756,7 +765,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do c `shouldBe` ExitFailure 1 describe "TRANS_DELETE_04 - False wallet ids via CLI" $ do - forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> do + forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> runResourceT $ do let txId = "3e6ec12da4414aa0781ff8afa9717ae53ee8cb4aa55d622f65bc62619a4f7b12" -- forget transaction once again (Exit c, Stdout out, Stderr err) <- @@ -772,7 +781,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do it "TRANS_DELETE_06 -\ \ Cannot forget tx that is performed from different wallet via CLI" - $ \ctx -> do + $ \ctx -> runResourceT $ do -- post tx wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx @@ -793,7 +802,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do , replicate 65 '1' , replicate 64 'ś' ] - forM_ txIds $ \tid -> it (show tid) $ \ctx -> do + forM_ txIds $ \tid -> it (show tid) $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx (Exit c, Stdout out, Stderr err) <- deleteTransactionViaCLI @t ctx wid tid @@ -803,7 +812,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do c `shouldBe` ExitFailure 1 it "BYRON_TX_LIST_03 -\ - \ Shelley CLI does not list Byron wallet transactions" $ \ctx -> do + \ Shelley CLI does not list Byron wallet transactions" $ \ctx -> runResourceT $ do wid <- emptyRandomWallet' ctx (Exit c, Stdout o, Stderr e) <- listTransactionsViaCLI @t ctx [wid] e `shouldContain` errMsg404NoWallet (T.pack wid) @@ -811,7 +820,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do c `shouldBe` ExitFailure 1 it "BYRON_TRANS_DELETE -\ - \ Cannot delete tx on Byron wallet using shelley CLI" $ \ctx -> do + \ Cannot delete tx on Byron wallet using shelley CLI" $ \ctx -> runResourceT $ do wid <- emptyRandomWallet' ctx (Exit c, Stdout o, Stderr e) <- deleteTransactionViaCLI @t ctx wid (replicate 64 '1') @@ -821,7 +830,7 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do describe "BYRON_TRANS_CREATE / BYRON_TRANS_ESTIMATE -\ \ Cannot create/estimate tx on Byron wallet using shelley CLI" $ do - forM_ ["create", "fees"] $ \action -> it action $ \ctx -> do + forM_ ["create", "fees"] $ \action -> it action $ \ctx -> runResourceT $ do wSrc <- emptyRandomWallet ctx wDest <- emptyWallet ctx addrs:_ <- listAddresses @n ctx wDest @@ -839,12 +848,13 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do c `shouldBe` ExitFailure 1 where postTxViaCLI - :: Context t + :: (MonadIO m, MonadFail m, MonadCatch m) + => Context t -> ApiWallet -> ApiWallet -> Natural -> Maybe Text - -> IO (ApiTransaction n) + -> m (ApiTransaction n) postTxViaCLI ctx wSrc wDest amt md = do args <- postTxArgs ctx wSrc wDest amt md @@ -855,12 +865,13 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do expectValidJSON (Proxy @(ApiTransaction n)) out postTxArgs - :: Context t + :: (MonadIO m, MonadFail m, MonadCatch m) + => Context t -> ApiWallet -> ApiWallet -> Natural -> Maybe Text - -> IO [String] + -> m [String] postTxArgs ctx wSrc wDest amt md = do addr:_ <- listAddresses @n ctx wDest let addrStr = encodeAddress @n (getApiT $ fst $ addr ^. #id) @@ -869,13 +880,13 @@ spec = describe "SHELLEY_CLI_TRANSACTIONS" $ do , "--payment", T.pack (show amt) <> "@" <> addrStr ] ++ maybe [] (\json -> ["--metadata", json]) md - fixtureWallet' :: Context t -> IO String + fixtureWallet' :: Context t -> ResourceT IO String fixtureWallet' = fmap (T.unpack . view walletId) . fixtureWallet - emptyWallet' :: Context t -> IO String + emptyWallet' :: Context t -> ResourceT IO String emptyWallet' = fmap (T.unpack . view walletId) . emptyWallet - emptyRandomWallet' :: Context t -> IO String + emptyRandomWallet' :: Context t -> ResourceT IO String emptyRandomWallet' = fmap (T.unpack . view walletId) . emptyRandomWallet sortOrderMatrix :: [Maybe SortOrder] diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Wallets.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Wallets.hs index 4b5c5d94ea3..e4ee60fda2d 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Wallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Shelley/Wallets.hs @@ -35,6 +35,12 @@ import Cardano.Wallet.Primitive.Types ( walletNameMaxLength, walletNameMinLength ) import Control.Monad ( forM_ ) +import Control.Monad.Catch + ( MonadCatch ) +import Control.Monad.IO.Class + ( MonadIO, liftIO ) +import Control.Monad.Trans.Resource + ( ResourceT, runResourceT ) import Data.Generics.Internal.VL.Lens ( view, (^.) ) import Data.Generics.Product.Typed @@ -105,14 +111,14 @@ spec :: forall n t. , EncodeAddress n ) => SpecWith (Context t) spec = describe "SHELLEY_CLI_WALLETS" $ do - it "BYRON_GET_03 - Shelley CLI does not show Byron wallet" $ \ctx -> do + it "BYRON_GET_03 - Shelley CLI does not show Byron wallet" $ \ctx -> runResourceT $ do wid <- emptyRandomWallet' ctx (Exit c, Stdout out, Stderr err) <- getWalletViaCLI @t ctx wid out `shouldBe` "" c `shouldBe` ExitFailure 1 err `shouldContain` errMsg404NoWallet (T.pack wid) - it "BYRON_LIST_03 - Shelley CLI does not list Byron wallet" $ \ctx -> do + it "BYRON_LIST_03 - Shelley CLI does not list Byron wallet" $ \ctx -> runResourceT $ do _ <- emptyRandomWallet' ctx wid <- emptyWallet' ctx (Exit c, Stdout out, Stderr err) <- listWalletsViaCLI @t ctx @@ -122,7 +128,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do length j `shouldBe` 1 expectCliListField 0 walletId (`shouldBe` T.pack wid) j - it "BYRON_DELETE_03 - Shelley CLI does not delete Byron wallet" $ \ctx -> do + it "BYRON_DELETE_03 - Shelley CLI does not delete Byron wallet" $ \ctx -> runResourceT $ do wid <- emptyRandomWallet' ctx (Exit c, Stdout out, Stderr err) <- deleteWalletViaCLI @t ctx wid out `shouldBe` "" @@ -130,7 +136,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do err `shouldContain` errMsg404NoWallet (T.pack wid) it "BYRON_WALLETS_UTXO -\ - \ Cannot show Byron wal utxo with shelley CLI" $ \ctx -> do + \ Cannot show Byron wal utxo with shelley CLI" $ \ctx -> runResourceT $ do wid <- emptyRandomWallet' ctx (Exit c, Stdout o, Stderr e) <- getWalletUtxoStatisticsViaCLI @t ctx wid c `shouldBe` ExitFailure 1 @@ -138,7 +144,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do o `shouldBe` mempty it "BYRON_WALLETS_UPDATE_PASS -\ - \ Cannot update Byron wal with shelley CLI" $ \ctx -> do + \ Cannot update Byron wal with shelley CLI" $ \ctx -> runResourceT $ do wid <- emptyRandomWallet' ctx let port = T.pack $ show $ ctx ^. typed @(Port "wallet") let args = T.unpack <$> @@ -150,7 +156,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do err `shouldContain` errMsg404NoWallet (T.pack wid) it "BYRON_WALLETS_UPDATE -\ - \ Cannot update name Byron wal with shelley CLI" $ \ctx -> do + \ Cannot update name Byron wal with shelley CLI" $ \ctx -> runResourceT $ do wid <- emptyRandomWallet' ctx let port = T.pack $ show $ ctx ^. typed @(Port "wallet") let args = T.unpack <$> @@ -161,7 +167,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do c `shouldBe` ExitFailure 1 err `shouldContain` errMsg404NoWallet (T.pack wid) - it "WALLETS_CREATE_01,08 - Can create a wallet" $ \ctx -> do + it "WALLETS_CREATE_01,08 - Can create a wallet" $ \ctx -> runResourceT $ do Stdout m <- generateMnemonicsViaCLI @t [] (c, out, err) <- createWalletViaCLI @t ctx ["n"] m "\n" "secure-passphrase" c `shouldBe` ExitSuccess @@ -183,12 +189,12 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do jg <- expectValidJSON (Proxy @ApiWallet) og expectCliField (#state . #getApiT) (`shouldBe` Ready) jg - it "WALLETS_CREATE_02 - Restored wallet preserves funds" $ \ctx -> do + it "WALLETS_CREATE_02 - Restored wallet preserves funds" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx -- create a wallet Stdout m <- generateMnemonicsViaCLI @t [] - (c1, o1, e1) <- createWalletViaCLI @t ctx ["n"] m "\n" "secure-passphrase" + (c1, o1, e1) <- liftIO $ createWalletViaCLI @t ctx ["n"] m "\n" "secure-passphrase" c1 `shouldBe` ExitSuccess T.unpack e1 `shouldContain` cmdOk wDest <- expectValidJSON (Proxy @ApiWallet) o1 @@ -247,7 +253,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do , expectCliField walletId (`shouldBe` wDest ^. walletId) ] - it "WALLETS_CREATE_03 - Cannot create wallet that exists" $ \ctx -> do + it "WALLETS_CREATE_03 - Cannot create wallet that exists" $ \ctx -> runResourceT $ do Stdout m1 <- generateMnemonicsViaCLI @t ["--size", "24"] Stdout m2 <- generateMnemonicsViaCLI @t ["--size", "12"] @@ -265,7 +271,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do \However, I already know of a wallet with this id." describe "WALLETS_CREATE_04 - Wallet names" $ do - forM_ walletNames $ \(title, n) -> it title $ \ctx -> do + forM_ walletNames $ \(title, n) -> it title $ \ctx -> runResourceT $ do Stdout m <- generateMnemonicsViaCLI @t ["--size", "18"] (c, o, e) <- createWalletViaCLI @t ctx [n] m "\n" "secure-passphrase" c `shouldBe` ExitSuccess @@ -275,7 +281,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do (#name . #getApiT . #getWalletName) (`shouldBe` T.pack n) j describe "WALLETS_CREATE_04 - Wallet names invalid" $ do - forM_ walletNamesInvalid $ \(name, expects) -> it expects $ \ctx -> do + forM_ walletNamesInvalid $ \(name, expects) -> it expects $ \ctx -> runResourceT $ do Stdout m <- generateMnemonicsViaCLI @t ["--size", "18"] (c, o, e) <- createWalletViaCLI @t ctx [name] m "\n" "secure-passphrase" c `shouldBe` ExitFailure 1 @@ -283,7 +289,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do o `shouldBe` "" describe "WALLETS_CREATE_05 - Can create wallet with different mnemonic sizes" $ do - forM_ ["15", "18", "21", "24"] $ \(size) -> it size $ \ctx -> do + forM_ ["15", "18", "21", "24"] $ \(size) -> it size $ \ctx -> runResourceT $ do let name = "Wallet created via CLI " Stdout mnemonics <- generateMnemonicsViaCLI @t ["--size", size] let pwd = "Secure passphrase" @@ -296,7 +302,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do (#name . #getApiT . #getWalletName) (`shouldBe` T.pack name) j describe "WALLETS_CREATE_05 - Can't create wallet with wrong size of mnemonic" $ do - forM_ ["9", "12"] $ \(size) -> it size $ \ctx -> do + forM_ ["9", "12"] $ \(size) -> it size $ \ctx -> runResourceT $ do let name = "Wallet created via CLI" Stdout m1 <- generateMnemonicsViaCLI @t ["--size", size] Stdout m2 <- generateMnemonicsViaCLI @t ["--size", size] @@ -312,7 +318,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do e `shouldBe` cmdOk describe "WALLETS_CREATE_06 - Can create wallet with different mnemonic snd factor sizes" $ do - forM_ ["9", "12"] $ \(size) -> it size $ \ctx -> do + forM_ ["9", "12"] $ \(size) -> it size $ \ctx -> runResourceT $ do let name = "Wallet created via CLI" Stdout m1 <- generateMnemonicsViaCLI @t [] Stdout m2 <- generateMnemonicsViaCLI @t ["--size", size] @@ -325,7 +331,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do (#name . #getApiT . #getWalletName) (`shouldBe` T.pack name) j describe "WALLETS_CREATE_06 - Can't create wallet with wrong size of mnemonic snd factor" $ do - forM_ ["15", "18", "21", "24"] $ \(size) -> it size $ \ctx -> do + forM_ ["15", "18", "21", "24"] $ \(size) -> it size $ \ctx -> runResourceT $ do let name = "Wallet created via CLI" Stdout m1 <- generateMnemonicsViaCLI @t ["--size", size] Stdout m2 <- generateMnemonicsViaCLI @t ["--size", size] @@ -354,7 +360,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do , ( "Polish", "aąbcćdeęfghijklłmnoóp" ) , ( "Kanji", "亜哀挨愛曖悪握圧扱宛嵐") ] - forM_ matrix $ \(title, pass) -> it title $ \ctx -> do + forM_ matrix $ \(title, pass) -> it title $ \ctx -> runResourceT $ do Stdout m <- generateMnemonicsViaCLI @t [] (c, o, e) <- createWalletViaCLI @t ctx ["Wallet name"] m "\n" pass c `shouldBe` ExitSuccess @@ -375,7 +381,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do [ ( "Pass below min length", passBelowMin, passMinWarn ) , ( "Pass above max length", passAboveMax, passMaxWarn ) ] - forM_ matrix $ \(title, pass, warn) -> it title $ \ctx -> do + forM_ matrix $ \(title, pass, warn) -> it title $ \ctx -> runResourceT $ do Stdout m <- generateMnemonicsViaCLI @t [] (c, o, e) <- createWalletViaCLI @t ctx ["Wallet name"] m "\n" pass c `shouldBe` ExitFailure 1 @@ -414,13 +420,13 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do , ( "arbitraty string -> fail", "string", expectsErr ) ] - forM_ matrix $ \(title, gap, expects) -> it title $ \ctx -> do + forM_ matrix $ \(title, gap, expects) -> it title $ \ctx -> runResourceT $ do Stdout m <- generateMnemonicsViaCLI @t [] (c, o, e) <- createWalletViaCLI @t ctx ["n", "--address-pool-gap", gap] m "\n" "secure-passphraze" expects c o e gap - it "WALLETS_GET_01 - Can get a wallet" $ \ctx -> do + it "WALLETS_GET_01 - Can get a wallet" $ \ctx -> runResourceT $ do walId <- emptyWallet' ctx (Exit c, Stdout out, Stderr err) <- getWalletViaCLI @t ctx walId c `shouldBe` ExitSuccess @@ -447,7 +453,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do expectCliField (#state . #getApiT) (`shouldBe` Ready) jg describe "WALLETS_GET_03,04 - Cannot get wallets with false ids" $ do - forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> do + forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> runResourceT $ do (Exit c, Stdout out, Stderr err) <- getWalletViaCLI @t ctx walId out `shouldBe` "" c `shouldBe` ExitFailure 1 @@ -456,7 +462,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do else err `shouldContain` errMsg400WalletIdEncoding - it "WALLETS_LIST_01 - Can list wallets" $ \ctx -> do + it "WALLETS_LIST_01 - Can list wallets" $ \ctx -> runResourceT $ do let name = "Wallet to be listed" w1 <- emptyWalletWith' ctx (name, "secure-passphrase", 21) _ <- emptyWallet' ctx @@ -480,7 +486,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do , expectCliListField 0 walletId (`shouldBe` T.pack w1) ] - it "WALLETS_LIST_01 - Wallets are listed from oldest to newest" $ \ctx -> do + it "WALLETS_LIST_01 - Wallets are listed from oldest to newest" $ \ctx -> runResourceT $ do w1 <- emptyWalletWith' ctx ("1", "secure-passphrase", 20) w2 <- emptyWalletWith' ctx ("2", "secure-passphrase", 20) w3 <- emptyWalletWith' ctx ("3", "secure-passphrase", 20) @@ -496,7 +502,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do ] describe "WALLETS_UPDATE_01,02 - Can update wallet name" $ do - forM_ walletNames $ \(title, n) -> it title $ \ctx -> do + forM_ walletNames $ \(title, n) -> it title $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx let args = [wid, n] (Exit c, Stdout out, Stderr err) <- @@ -508,7 +514,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do (#name . #getApiT . #getWalletName) (`shouldBe` T.pack n) j it "WALLETS_UPDATE_PASS_01 - Can update passphrase normally" - $ \ctx -> do + $ \ctx -> runResourceT $ do let name = "name" let ppOld = "old secure passphrase" let ppNew = "new secure passphrase" @@ -563,7 +569,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do , expect (ExitSuccess, "\n", cmdOk) ) ] - forM_ matrix $ \(title, ppNew, expectations) -> it title $ \ctx -> do + forM_ matrix $ \(title, ppNew, expectations) -> it title $ \ctx -> runResourceT $ do let name = "name" let ppOld = "old secure passphrase" let addrPoolMin = fromIntegral @_ @Int $ getAddressPoolGap minBound @@ -574,7 +580,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do it "WALLETS_UPDATE_PASS_02 - \ \Cannot update passphrase if new passphrase is not confirmed correctly" - $ \ctx -> do + $ \ctx -> runResourceT $ do let name = "name" let ppOld = "old secure passphrase" let ppNew1 = "new secure passphrase 1" @@ -608,7 +614,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do , expect (ExitFailure 1, mempty, errMsg403WrongPass) ) ] - forM_ matrix $ \(title, ppOldWrong, expectations) -> it title $ \ctx -> do + forM_ matrix $ \(title, ppOldWrong, expectations) -> it title $ \ctx -> runResourceT $ do let name = "name" let ppOldRight = "right secure passphrase" let ppNew = "new secure passphrase" @@ -633,7 +639,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do , expect (ExitSuccess, "\n", cmdOk) ) ] - forM_ matrix $ \(title, ppOldRight, expectations) -> it title $ \ctx -> do + forM_ matrix $ \(title, ppOldRight, expectations) -> it title $ \ctx -> runResourceT $ do let name = "name" let ppNew = replicate maxLength 'ź' let addrPoolMin = fromIntegral @_ @Int $ getAddressPoolGap minBound @@ -644,7 +650,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do expectations (exitCode, out, err) describe "WALLETS_UPDATE_PASS_04 - Cannot update pass of wallets with false ids" $ do - forM_ falseWalletIds $ \(title, wid) -> it title $ \ctx -> do + forM_ falseWalletIds $ \(title, wid) -> it title $ \ctx -> runResourceT $ do let ppOld = "right secure passphrase" let ppNew = "new secure passphrase" (c, out, err) <- @@ -674,7 +680,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do ) ] - forM_ matrix $ \(title, pass, expectations) -> it title $ \ctx -> do + forM_ matrix $ \(title, pass, expectations) -> it title $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx addr:_ <- listAddresses @n ctx wDest @@ -692,7 +698,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do (cTx, outTx, errTx) <- postTransactionViaCLI @t ctx pass args expectations (cTx, outTx, errTx) - it "WALLETS_DELETE_01, WALLETS_LIST_02 - Can delete wallet" $ \ctx -> do + it "WALLETS_DELETE_01, WALLETS_LIST_02 - Can delete wallet" $ \ctx -> runResourceT $ do walId <- emptyWallet' ctx (Exit c, Stdout out, Stderr err) <- deleteWalletViaCLI @t ctx walId err `shouldBe` cmdOk @@ -702,7 +708,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do o `shouldBe` "[]\n" e `shouldBe` cmdOk - it "WALLETS_UTXO_01 - Wallet's inactivity is reflected in utxo" $ \ctx -> do + it "WALLETS_UTXO_01 - Wallet's inactivity is reflected in utxo" $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx (Exit c, Stdout o, Stderr e) <- getWalletUtxoStatisticsViaCLI @t ctx wid c `shouldBe` ExitSuccess @@ -710,7 +716,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do utxoStats <- expectValidJSON (Proxy @ApiUtxoStatistics) o expectWalletUTxO [] (Right utxoStats) - it "WALLETS_UTXO_02 - Utxo statistics works properly" $ \ctx -> do + it "WALLETS_UTXO_02 - Utxo statistics works properly" $ \ctx -> runResourceT $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx @@ -744,7 +750,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do expectWalletUTxO coins (Right utxoStats1) describe "WALLETS_UTXO_03 - non-existing wallets" $ do - forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> do + forM_ falseWalletIds $ \(title, walId) -> it title $ \ctx -> runResourceT $ do (Exit c, Stdout out, Stderr err) <- getWalletUtxoStatisticsViaCLI @t ctx walId out `shouldBe` mempty c `shouldBe` ExitFailure 1 @@ -753,7 +759,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do else err `shouldContain` errMsg400WalletIdEncoding - it "WALLETS_UTXO_03 - Deleted wallet is not available for utxo" $ \ctx -> do + it "WALLETS_UTXO_03 - Deleted wallet is not available for utxo" $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx Exit cd <- deleteWalletViaCLI @t ctx wid cd `shouldBe` ExitSuccess @@ -763,7 +769,7 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do e `shouldContain` errMsg404NoWallet (T.pack wid) o `shouldBe` mempty - it "WALLETS_UTXO_03 - 'almost' valid walletId" $ \ctx -> do + it "WALLETS_UTXO_03 - 'almost' valid walletId" $ \ctx -> runResourceT $ do wid <- emptyWallet' ctx (Exit c, Stdout o, Stderr e) <- getWalletUtxoStatisticsViaCLI @t ctx (wid ++ "1") @@ -777,13 +783,18 @@ spec = describe "SHELLEY_CLI_WALLETS" $ do out `shouldBe` expOut T.unpack err `shouldContain` expErr -emptyRandomWallet' :: Context t -> IO String +emptyRandomWallet' + :: (MonadIO m, MonadCatch m) + => Context t + -> ResourceT m String emptyRandomWallet' = fmap (T.unpack . view walletId) . emptyRandomWallet -emptyWallet' :: Context t -> IO String +emptyWallet' :: (MonadIO m, MonadCatch m) => Context t -> ResourceT m String emptyWallet' = fmap (T.unpack . view walletId) . emptyWallet -emptyWalletWith' :: Context t -> (Text, Text, Int) -> IO String +emptyWalletWith' + :: (MonadIO m, MonadCatch m) + => Context t -> (Text, Text, Int) -> ResourceT m String emptyWalletWith' ctx (name, pass, pg) = fmap (T.unpack . view walletId) (emptyWalletWith ctx (name, pass, pg)) diff --git a/lib/jormungandr/test/bench/Latency.hs b/lib/jormungandr/test/bench/Latency.hs index fe950976245..f6c8f0d31da 100644 --- a/lib/jormungandr/test/bench/Latency.hs +++ b/lib/jormungandr/test/bench/Latency.hs @@ -73,6 +73,8 @@ import Control.Exception ( throwIO ) import Control.Monad ( mapM_, replicateM, replicateM_ ) +import Control.Monad.IO.Class + ( liftIO ) import Data.Aeson ( Value ) import Data.Aeson.QQ @@ -113,6 +115,8 @@ import Test.Integration.Framework.DSL , json , listAddresses , request + , runResourceT + , runResourceT , verify ) @@ -232,7 +236,7 @@ walletApiBench capture benchWithServer = do replicateM_ batchSize (postTx ctx (wSrc, Link.createTransaction @'Shelley, pass) wDest amtToSend) - eventually "repeatPostTx: wallet balance is as expected" $ do + liftIO $ eventually "repeatPostTx: wallet balance is as expected" $ do rWal1 <- request @ApiWallet ctx (Link.getWallet @'Shelley wDest) Default Empty verify rWal1 [ expectSuccess @@ -242,7 +246,7 @@ walletApiBench capture benchWithServer = do ] rDel <- request @ApiWallet ctx (Link.deleteWallet @'Shelley wSrc) Default Empty - expectResponseCode @IO HTTP.status204 rDel + expectResponseCode HTTP.status204 rDel pure () @@ -269,7 +273,7 @@ walletApiBench capture benchWithServer = do postMultiTx ctx (wSrc, Link.createTransaction @'Shelley, fixturePassphrase) wDest amtToSend batchSize - eventually "repeatPostMultiTx: wallet balance is as expected" $ do + liftIO $ eventually "repeatPostMultiTx: wallet balance is as expected" $ do rWal1 <- request @ApiWallet ctx (Link.getWallet @'Shelley wDest) Default Empty verify rWal1 @@ -280,11 +284,11 @@ walletApiBench capture benchWithServer = do ] rStat <- request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Shelley wDest) Default Empty - expectResponseCode @IO HTTP.status200 rStat + expectResponseCode HTTP.status200 rStat expectWalletUTxO utxoExp (snd rStat) rDel <- request @ApiWallet ctx (Link.deleteWallet @'Shelley wSrc) Default Empty - expectResponseCode @IO HTTP.status204 rDel + expectResponseCode HTTP.status204 rDel pure () @@ -309,9 +313,7 @@ walletApiBench capture benchWithServer = do expectResponseCode HTTP.status202 r return () - runScenario scenario = benchWithServer $ \ctx -> do - (wal1, wal2) <- scenario ctx - + runScenario scenario = benchWithServer $ \ctx -> runResourceT $ scenario ctx >>= \(wal1, wal2) -> liftIO $ do t1 <- measureApiLogs capture (request @[ApiWallet] ctx (Link.listWallets @'Shelley) Default Empty) diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Addresses.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Addresses.hs index 8fc4e765862..8d71c6f8f06 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Addresses.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Addresses.hs @@ -54,6 +54,7 @@ import Test.Integration.Framework.DSL , listAddresses , minUTxOValue , request + , runResourceT , verify , walletId ) @@ -70,62 +71,62 @@ spec :: forall n t. , EncodeAddress n ) => SpecWith (Context t) spec = describe "SHELLEY_ADDRESSES" $ do - it "BYRON_ADDRESS_LIST - Byron wallet on Shelley ep" $ \ctx -> do + it "BYRON_ADDRESS_LIST - Byron wallet on Shelley ep" $ \ctx -> runResourceT $ do w <- emptyRandomWallet ctx let wid = w ^. walletId let ep = ("GET", "v2/wallets/" <> wid <> "/addresses") r <- request @[ApiAddress n] ctx ep Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet wid) r - it "ADDRESS_LIST_01 - Can list known addresses on a default wallet" $ \ctx -> do + it "ADDRESS_LIST_01 - Can list known addresses on a default wallet" $ \ctx -> runResourceT $ do let g = fromIntegral $ getAddressPoolGap defaultAddressPoolGap w <- emptyWallet ctx r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r expectListSize g r forM_ [0..(g-1)] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) r - it "ADDRESS_LIST_01 - Can list addresses with non-default pool gap" $ \ctx -> do + it "ADDRESS_LIST_01 - Can list addresses with non-default pool gap" $ \ctx -> runResourceT $ do let g = 15 w <- emptyWalletWith ctx ("Wallet", "cardano-wallet", g) r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status200 r + expectResponseCode HTTP.status200 r expectListSize g r forM_ [0..(g-1)] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) r - it "ADDRESS_LIST_02 - Can filter used and unused addresses" $ \ctx -> do + it "ADDRESS_LIST_02 - Can filter used and unused addresses" $ \ctx -> runResourceT $ do let g = fromIntegral $ getAddressPoolGap defaultAddressPoolGap w <- fixtureWallet ctx rUsed <- request @[ApiAddress n] ctx (Link.listAddresses' @'Shelley w (Just Used)) Default Empty - expectResponseCode @IO HTTP.status200 rUsed + expectResponseCode HTTP.status200 rUsed expectListSize 10 rUsed forM_ [0..9] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Used) rUsed rUnused <- request @[ApiAddress n] ctx (Link.listAddresses' @'Shelley w (Just Unused)) Default Empty - expectResponseCode @IO HTTP.status200 rUnused + expectResponseCode HTTP.status200 rUnused expectListSize g rUnused forM_ [10..(g-1)] $ \addrNum -> do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) rUnused it "ADDRESS_LIST_02 - Shows nothing when there are no used addresses" - $ \ctx -> do + $ \ctx -> runResourceT $ do w <- emptyWallet ctx rUsed <- request @[ApiAddress n] ctx (Link.listAddresses' @'Shelley w (Just Used)) Default Empty rUnused <- request @[ApiAddress n] ctx (Link.listAddresses' @'Shelley w (Just Unused)) Default Empty - expectResponseCode @IO HTTP.status200 rUsed + expectResponseCode HTTP.status200 rUsed expectListSize 0 rUsed - expectResponseCode @IO HTTP.status200 rUnused + expectResponseCode HTTP.status200 rUnused expectListSize 20 rUnused forM_ [0..19] $ \addrNum -> do expectListField @@ -147,19 +148,19 @@ spec = describe "SHELLEY_ADDRESSES" $ do ] let withQuery f (method, link) = (method, link <> "?state=" <> T.pack f) - forM_ filters $ \fil -> it fil $ \ctx -> do + forM_ filters $ \fil -> it fil $ \ctx -> runResourceT $ do w <- emptyWallet ctx let link = withQuery fil $ Link.listAddresses @'Shelley w r <- request @[ApiAddress n] ctx link Default Empty verify r - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage $ "Error parsing query parameter state failed: Unable to\ \ decode the given value: '" <> fil <> "'. Please specify\ \ one of the following values: used, unused." ] - it "ADDRESS_LIST_03 - Generates new address pool gap" $ \ctx -> do + it "ADDRESS_LIST_03 - Generates new address pool gap" $ \ctx -> runResourceT $ do let initPoolGap = 10 wSrc <- fixtureWallet ctx wDest <- emptyWalletWith ctx ("Wallet", "cardano-wallet", initPoolGap) @@ -168,7 +169,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley wDest) Default Empty verify r - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize initPoolGap ] forM_ [0..9] $ \addrNum -> do @@ -191,7 +192,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do rTrans <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload - expectResponseCode @IO HTTP.status202 rTrans + expectResponseCode HTTP.status202 rTrans -- make sure all transactions are in ledger eventually "Wallet balance = initPoolGap * minUTxOValue" $ do @@ -206,7 +207,7 @@ spec = describe "SHELLEY_ADDRESSES" $ do rAddr <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley wDest) Default Empty verify rAddr - [ expectResponseCode @IO HTTP.status200 + [ expectResponseCode HTTP.status200 , expectListSize 20 ] forM_ [0..9] $ \addrNum -> do @@ -216,11 +217,11 @@ spec = describe "SHELLEY_ADDRESSES" $ do expectListField addrNum (#state . #getApiT) (`shouldBe` Unused) rAddr - it "ADDRESS_LIST_04 - Deleted wallet" $ \ctx -> do + it "ADDRESS_LIST_04 - Deleted wallet" $ \ctx -> runResourceT $ do w <- emptyWallet ctx _ <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty r <- request @[ApiAddress n] ctx (Link.listAddresses @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status404 r + expectResponseCode HTTP.status404 r expectErrorMessage (errMsg404NoWallet $ w ^. walletId) r diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs index a73b321a077..25d32713066 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs @@ -32,6 +32,8 @@ import Cardano.Wallet.Primitive.Types ( Direction (..), FeePolicy (..), PoolId (..), TxStatus (..) ) import Cardano.Wallet.Transaction ( DelegationAction (..) ) +import Control.Monad.IO.Class + ( liftIO ) import Data.Functor.Identity ( Identity (..) ) import Data.Generics.Internal.VL.Lens @@ -54,6 +56,7 @@ import Test.Integration.Framework.DSL ( Context (..) , Headers (..) , Payload (..) + , ResourceT , TxDescription (..) , delegating , delegationFee @@ -82,6 +85,8 @@ import Test.Integration.Framework.DSL , quitStakePool , request , restoreWalletFromPubKey + , runResourceT + , runResourceT , unsafeRequest , verify , waitAllTxsInLedger @@ -115,22 +120,22 @@ spec :: forall n t. ) => SpecWith (Port "node", FeePolicy, Context t) spec = do describe "HW_WALLETS_02,03 - Delegation with restored HW Wallets" $ do - it "HW_WALLETS_03 - Cannot join SP" $ \(_,_,ctx) -> do + it "HW_WALLETS_03 - Cannot join SP" $ \(_,_,ctx) -> runResourceT @IO $ do (w, mnemonics) <- fixtureWalletWithMnemonics ctx let pubKey = pubKeyFromMnemonics mnemonics r <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status204 r + expectResponseCode HTTP.status204 r wk <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx pubKey "Wallet from pubkey" -- cannot join stake pool - (_, p:_) <- eventually "Stake pools are listed" $ + (_, p:_) <- liftIO $ eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty rJoin <- joinStakePool @n ctx (p ^. #id) (wk, fixturePassphrase) - expectResponseCode @IO HTTP.status403 rJoin + expectResponseCode HTTP.status403 rJoin expectErrorMessage (errMsg403NoRootKey $ wk ^. walletId) rJoin it "HW_WALLETS_02 - Restoration from account public key preserves delegation\ - \ but I cannot quit" $ \(_,_,ctx) -> do + \ but I cannot quit" $ \(_,_,ctx) -> runResourceT @IO $ do -- create wallet and get acc pub key from mnemonics (w, mnemonics) <- fixtureWalletWithMnemonics ctx let accPub = pubKeyFromMnemonics mnemonics @@ -143,7 +148,7 @@ spec = do (_, p:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty r <- joinStakePool @n ctx (p ^. #id) (w, fixturePassphrase) - expectResponseCode @IO HTTP.status202 r + expectResponseCode HTTP.status202 r waitAllTxsInLedger @n ctx w let expectedDelegation = [ expectField #delegation @@ -158,7 +163,7 @@ spec = do -- delete wallet rDel <- request @ApiWallet ctx (Link.deleteWallet @'Shelley w) Default Empty - expectResponseCode @IO HTTP.status204 rDel + expectResponseCode HTTP.status204 rDel -- restore from pub key and make sure delegation preserved wRestored <- restoreWalletFromPubKey @ApiWallet @'Shelley ctx accPub "Wallet from pubkey" @@ -167,11 +172,11 @@ spec = do -- cannot quit stake pool rQuit <- quitStakePool @n ctx (wRestored, fixturePassphrase) - expectResponseCode @IO HTTP.status403 rQuit + expectResponseCode HTTP.status403 rQuit expectErrorMessage (errMsg403NoRootKey $ wRestored ^. walletId) rQuit - it "STAKE_POOLS_LIST_01 - List stake pools" $ \(_,_,ctx) -> do - eventually "Listing stake pools shows expected information" $ do + it "STAKE_POOLS_LIST_01 - List stake pools" $ \(_,_,ctx) -> runResourceT @IO $ do + liftIO $ eventually "Listing stake pools shows expected information" $ do r <- request @[ApiStakePool] ctx Link.listJormungandrStakePools Default Empty expectResponseCode HTTP.status200 r verify r @@ -227,7 +232,7 @@ spec = do #saturation (.>= 0) ] - it "STAKE_POOLS_LIST_02 - May fail on epoch boundaries" $ \(_,_,ctx) -> do + it "STAKE_POOLS_LIST_02 - May fail on epoch boundaries" $ \(_,_,ctx) -> runResourceT @IO $ do -- We should be able to catch the stake-pool data in an un-synced state -- when we enter into a new epoch. The results should then be -- unavailible. @@ -235,7 +240,7 @@ spec = do -- This might take a few tries (epoch changes), so it is only feasible -- to test with very short epochs. let ms = 1000 - eventuallyUsingDelay (50*ms) + liftIO $ eventuallyUsingDelay (50*ms) "Shows error when listing stake pools on epoch boundaries" $ do r <- request @[ApiStakePool] ctx Link.listJormungandrStakePools Default Empty @@ -274,7 +279,7 @@ spec = do let (Just poolC) = find ((== ApiT poolIdC) . view #id) pools' fmap (view #owner . getApiT) (poolC ^. #metadata) `shouldBe` Just poolCOwner - it "STAKE_POOLS_JOIN_01 - Can join a stakepool" $ \(_,_,ctx) -> do + it "STAKE_POOLS_JOIN_01 - Can join a stakepool" $ \(_,_,ctx) -> runResourceT @IO $ do w <- fixtureWallet ctx (_, p:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty @@ -296,7 +301,7 @@ spec = do (#status . #getApiT) (`shouldBe` InLedger) ] - it "STAKE_POOLS_JOIN_01 - Controlled stake increases when joining" $ \(_,_,ctx) -> do + it "STAKE_POOLS_JOIN_01 - Controlled stake increases when joining" $ \(_,_,ctx) -> runResourceT @IO $ do w <- fixtureWallet ctx (_, Right (p:_)) <- eventually "Stake pools are listed" $ request @[ApiStakePool] ctx Link.listJormungandrStakePools Default Empty @@ -330,9 +335,9 @@ spec = do -- tests may take effect. ] - it "STAKE_POOLS_JOIN_04 - Rewards accumulate and stop" $ \(_,_,ctx) -> do + it "STAKE_POOLS_JOIN_04 - Rewards accumulate and stop" $ \(_,_,ctx) -> runResourceT @IO $ do - pendingWith "https://github.com/input-output-hk/cardano-wallet/issues/2140" + liftIO $ pendingWith "https://github.com/input-output-hk/cardano-wallet/issues/2140" w <- fixtureWallet ctx (_, p:_) <- eventually "Stake pools are listed" $ @@ -367,9 +372,9 @@ spec = do ] it "STAKE_POOLS_JOIN_04 -\ - \Delegate, stop in the next epoch, and still earn rewards" $ \(_,_,ctx) -> do + \Delegate, stop in the next epoch, and still earn rewards" $ \(_,_,ctx) -> runResourceT @IO $ do - pendingWith "https://github.com/input-output-hk/cardano-wallet/issues/2140" + liftIO $ pendingWith "https://github.com/input-output-hk/cardano-wallet/issues/2140" w <- fixtureWallet ctx (_, p1:_) <- eventually "Stake pools are listed" $ @@ -405,7 +410,7 @@ spec = do describe "STAKE_POOLS_JOIN_01x - Fee boundary values" $ do it "STAKE_POOLS_JOIN_01x - \ - \I can join if I have just the right amount" $ \(_,_,ctx) -> do + \I can join if I have just the right amount" $ \(_,_,ctx) -> runResourceT @IO $ do (_, p:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty let (fee, _) = ctx ^. #_feeEstimator $ DelegDescription (Join dummyPool) @@ -417,7 +422,7 @@ spec = do ] it "STAKE_POOLS_JOIN_01x - \ - \I cannot join if I have not enough fee to cover" $ \(_,_,ctx) -> do + \I cannot join if I have not enough fee to cover" $ \(_,_,ctx) -> runResourceT @IO $ do (_, p:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty let (fee, _) = ctx ^. #_feeEstimator $ DelegDescription (Join dummyPool) @@ -426,7 +431,7 @@ spec = do expectResponseCode HTTP.status403 r expectErrorMessage (errMsg403DelegationFee 1) r - it "STAKE_POOLS_JOIN_01x - I cannot join stake-pool with 0 balance" $ \(_,_,ctx) -> do + it "STAKE_POOLS_JOIN_01x - I cannot join stake-pool with 0 balance" $ \(_,_,ctx) -> runResourceT @IO $ do (_, p:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty w <- emptyWallet ctx @@ -437,7 +442,7 @@ spec = do describe "STAKE_POOLS_QUIT_01x - Fee boundary values" $ do it "STAKE_POOLS_QUIT_01x - \ - \I can quit if I have enough to cover fee" $ \(_,_,ctx) -> do + \I can quit if I have enough to cover fee" $ \(_,_,ctx) -> runResourceT @IO $ do let (_, feeJoin) = ctx ^. #_feeEstimator $ DelegDescription (Join dummyPool) let (feeQuit, _) = ctx ^. #_feeEstimator $ DelegDescription Quit let initBalance = [feeJoin + feeQuit + 3] @@ -455,7 +460,7 @@ spec = do ] it "STAKE_POOLS_QUIT_01x - \ - \I cannot quit if I have not enough fee to cover" $ \(_,_,ctx) -> do + \I cannot quit if I have not enough fee to cover" $ \(_,_,ctx) -> runResourceT @IO $ do let (_, feeJoin) = ctx ^. #_feeEstimator $ DelegDescription (Join dummyPool) let (feeQuit, _) = ctx ^. #_feeEstimator $ DelegDescription Quit let initBalance = [feeJoin+1] @@ -466,7 +471,7 @@ spec = do , expectErrorMessage (errMsg403DelegationFee (feeQuit - 1)) ] - it "STAKE_POOLS_JOIN_01 - I cannot rejoin the same stake-pool" $ \(_,_,ctx) -> do + it "STAKE_POOLS_JOIN_01 - I cannot rejoin the same stake-pool" $ \(_,_,ctx) -> runResourceT @IO $ do let (_, feeJoin) = ctx ^. #_feeEstimator $ DelegDescription (Join dummyPool) (w, p) <- joinStakePoolWithWalletBalance @n ctx [10*feeJoin] @@ -476,7 +481,7 @@ spec = do let poolId = toText $ getApiT $ p ^. #id expectErrorMessage (errMsg403PoolAlreadyJoined poolId) r - it "STAKE_POOLS_JOIN_01 - Cannot join non-existent stakepool" $ \(_,_,ctx) -> do + it "STAKE_POOLS_JOIN_01 - Cannot join non-existent stakepool" $ \(_,_,ctx) -> runResourceT @IO $ do let poolIdAbsent = PoolId $ BS.pack $ replicate 32 0 w <- emptyWallet ctx r <- joinStakePool @n ctx (ApiT poolIdAbsent) (w, fixturePassphrase) @@ -484,7 +489,7 @@ spec = do expectErrorMessage (errMsg404NoSuchPool (toText poolIdAbsent)) r it "STAKE_POOLS_JOIN_01 - \ - \ If a wallet joins a stake pool, others are not affected" $ \(_,_,ctx) -> do + \ If a wallet joins a stake pool, others are not affected" $ \(_,_,ctx) -> runResourceT @IO $ do (wA, wB) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx (_, p:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty @@ -522,7 +527,7 @@ spec = do ] describe "STAKE_POOLS_JOIN_02 - Passphrase must be correct to join" $ do - let verifyIt ctx wallet pass expectations = do + let verifyIt ctx wallet pass expectations = runResourceT @IO $ do (_, p:_) <- eventually "Stake pools are listed" $ do unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty w <- wallet ctx @@ -569,7 +574,7 @@ spec = do "passphrase is too long: expected at most 255 characters" let passTooLong = replicate (pMax + 1) '1' - let verifyIt ctx doStakePool pass expec = do + let verifyIt ctx doStakePool pass expec = runResourceT @IO $ do (_, p:_) <- eventually "Stake pools are listed" $ do unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty w <- emptyWallet ctx @@ -584,7 +589,7 @@ spec = do verifyIt ctx (\_ _ -> quitStakePool @n ctx) passTooLong tooLongMsg describe "STAKE_POOLS_JOIN/QUIT_02 - Passphrase must be text" $ do - let verifyIt ctx sPoolEndp = do + let verifyIt ctx sPoolEndp = runResourceT @IO $ do (_, p:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty w <- emptyWallet ctx @@ -598,7 +603,7 @@ spec = do it "Quit" $ \(_,_,ctx) -> do verifyIt ctx (const Link.quitStakePool) - it "STAKE_POOLS_JOIN_03 - Byron wallet cannot join stake pool" $ \(_,_,ctx) -> do + it "STAKE_POOLS_JOIN_03 - Byron wallet cannot join stake pool" $ \(_,_,ctx) -> runResourceT @IO $ do (_, p:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty w <- emptyRandomWallet ctx @@ -611,7 +616,7 @@ spec = do -- 1/ We are in Jörmungandr scenario were fees can be known exactly -- 2/ Fixture wallets are made of homogeneous UTxOs (all equal to the same -- value) and therefore, the random selection has no influence. - it "STAKE_POOLS_ESTIMATE_FEE_01 - fee matches eventual cost" $ \(_,_,ctx) -> do + it "STAKE_POOLS_ESTIMATE_FEE_01 - fee matches eventual cost" $ \(_,_,ctx) -> runResourceT @IO $ do (_, p:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty w <- fixtureWallet ctx @@ -624,8 +629,8 @@ spec = do [ expectField #amount (`shouldBe` fee) ] - it "STAKE_POOLS_ESTIMATE_FEE_01x - edge-case fee in-between coeff" $ \(_,_,ctx) -> do - pendingWith + it "STAKE_POOLS_ESTIMATE_FEE_01x - edge-case fee in-between coeff" $ \(_,_,ctx) -> runResourceT @IO $ do + liftIO $ pendingWith "This is currently testing two different things. On one hand \ \the fee estimator from the integration tests, and on the other \ \hand, the fee estimation from the API. These are not quite aligned \ @@ -641,7 +646,7 @@ spec = do ] it "STAKE_POOLS_ESTIMATE_FEE_02 - \ - \empty wallet cannot estimate fee" $ \(_,_,ctx) -> do + \empty wallet cannot estimate fee" $ \(_,_,ctx) -> runResourceT @IO $ do w <- emptyWallet ctx let (fee, _) = ctx ^. #_feeEstimator $ DelegDescription (Join dummyPool) delegationFee ctx w >>= flip verify @@ -649,7 +654,7 @@ spec = do , expectErrorMessage $ errMsg403DelegationFee fee ] - it "STAKE_POOLS_ESTIMATE_FEE_03 - can't use byron wallets" $ \(_,_,ctx) -> do + it "STAKE_POOLS_ESTIMATE_FEE_03 - can't use byron wallets" $ \(_,_,ctx) -> runResourceT @IO $ do w <- fixtureRandomWallet ctx let ep = Link.getDelegationFee w r <- request @(ApiTransaction n) ctx ep Default Empty @@ -659,7 +664,7 @@ spec = do ] describe "STAKE_POOLS_JOIN/QUIT_05 - Bad request" $ do - let verifyIt ctx sPoolEndp = do + let verifyIt ctx sPoolEndp = runResourceT @IO $ do w <- emptyWallet ctx let payload = NonJson "{ passphrase: Secure Passphrase }" r <- request @(ApiTransaction n) ctx @@ -671,23 +676,23 @@ spec = do it "Quit" $ \(_,_,ctx) -> do verifyIt ctx (const Link.quitStakePool) - it "STAKE_POOLS_QUIT_01 - Quiting before even joining" $ \(_,_,ctx) -> do + it "STAKE_POOLS_QUIT_01 - Quiting before even joining" $ \(_,_,ctx) -> runResourceT @IO $ do w <- emptyWallet ctx r <- quitStakePool @n ctx (w, "Secure Passprase") expectResponseCode HTTP.status403 r expectErrorMessage errMsg403NotDelegating r - it "STAKE_POOLS_QUIT_02 - Passphrase must be correct to quit" $ \(_,_,ctx) -> do + it "STAKE_POOLS_QUIT_02 - Passphrase must be correct to quit" $ \(_,_,ctx) -> runResourceT @IO $ do (w, _) <- joinStakePoolWithFixtureWallet @n ctx r <- quitStakePool @n ctx (w, "Incorrect Passphrase") expectResponseCode HTTP.status403 r expectErrorMessage errMsg403WrongPass r - it "STAKE_POOL_NEXT_01 - Can join/re-join another but cannot quit stake pool" $ \(_,_,ctx) -> do + it "STAKE_POOL_NEXT_01 - Can join/re-join another but cannot quit stake pool" $ \(_,_,ctx) -> runResourceT @IO $ do - pendingWith "https://github.com/input-output-hk/cardano-wallet/issues/2140" + liftIO $ pendingWith "https://github.com/input-output-hk/cardano-wallet/issues/2140" (_, p1:p2:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty @@ -744,14 +749,14 @@ spec = do it "STAKE_POOL_NEXT_02/STAKE_POOLS_QUIT_01 - Cannot quit when active: not_delegating" - $ \(_,_,ctx) -> do + $ \(_,_,ctx) -> runResourceT @IO $ do w <- emptyWallet ctx r <- quitStakePool @n ctx (w, "Secure Passprase") expectResponseCode HTTP.status403 r expectErrorMessage errMsg403NotDelegating r it "STAKE_POOL_NEXT_02 - Override join with join in the same epoch =>\ - \ delegating to the last one in the end" $ \(_,_,ctx) -> do + \ delegating to the last one in the end" $ \(_,_,ctx) -> runResourceT @IO $ do (_, p1:p2:_) <- eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty w <- fixtureWallet ctx @@ -783,8 +788,8 @@ spec = do it "STAKE_POOL_NEXT_03 - Join 2 in two subsequent epochs => delegating to 1st in epoch X + 2\ \ and 2nd in epoch X + 3" - $ \(_,_,ctx) -> do - (_, p1:p2:_) <- eventually "Stake pools are listed" $ + $ \(_,_,ctx) -> runResourceT @IO $ do + (_, p1:p2:_) <- liftIO $ eventually "Stake pools are listed" $ unsafeRequest @[ApiStakePool] ctx Link.listJormungandrStakePools Empty w <- fixtureWallet ctx @@ -851,7 +856,7 @@ joinStakePoolWithWalletBalance ) => (Context t) -> [Natural] - -> IO (ApiWallet, ApiStakePool) + -> ResourceT IO (ApiWallet, ApiStakePool) joinStakePoolWithWalletBalance ctx balance = do w <- fixtureWalletWith @n ctx balance (_, p:_) <- eventually "Stake pools are listed in joinStakePoolWithWalletBalance" $ @@ -873,7 +878,7 @@ joinStakePoolWithFixtureWallet , DecodeStakeAddress n ) => (Context t) - -> IO (ApiWallet, ApiStakePool) + -> ResourceT IO (ApiWallet, ApiStakePool) joinStakePoolWithFixtureWallet ctx = do w <- fixtureWallet ctx (_, p:_) <- eventually "Stake pools are listed in joinStakePoolWithFixtureWallet" $ @@ -881,7 +886,7 @@ joinStakePoolWithFixtureWallet ctx = do r <- joinStakePool @n ctx (p ^. #id) (w, fixturePassphrase) expectResponseCode HTTP.status202 r -- Verify the certificate was discovered - eventually "Tx in ledger in joinStakePoolWithFixtureWallet" $ do + liftIO $ eventually "Tx in ledger in joinStakePoolWithFixtureWallet" $ do let ep = Link.listTransactions @'Shelley w request @[ApiTransaction n] ctx ep Default Empty >>= flip verify [ expectListField 0 (#direction . #getApiT) (`shouldBe` Outgoing) diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs index 016b32ffb40..86f120fd58c 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/Transactions.hs @@ -58,6 +58,8 @@ import Cardano.Wallet.Transaction ( TransactionLayer (..) ) import Control.Monad ( forM_ ) +import Control.Monad.IO.Class + ( liftIO ) import Data.ByteArray.Encoding ( Base (Base16, Base64), convertFromBase, convertToBase ) import Data.Generics.Internal.VL.Lens @@ -81,6 +83,7 @@ import Test.Integration.Framework.DSL as DSL , Headers (..) , MnemonicLength (..) , Payload (..) + , ResourceT , TxDescription (..) , between , emptyRandomWallet @@ -103,7 +106,9 @@ import Test.Integration.Framework.DSL as DSL , json , listAddresses , listAllTransactions + , postWallet , request + , runResourceT , unsafeRequest , verify , walletId @@ -140,7 +145,7 @@ spec :: forall n t. , DelegationAddress n JormungandrKey ) => SpecWith (Context t) spec = do - it "TRANS_CREATE_01 - Single Output Transaction" $ \ctx -> do + it "TRANS_CREATE_01 - Single Output Transaction" $ \ctx -> runResourceT @IO $ do (wa, wb) <- (,) <$> fixtureWallet ctx <*> fixtureWallet ctx let amt = (1 :: Natural) @@ -199,7 +204,7 @@ spec = do (#balance . #getApiT . #available) (`shouldBe` Quantity (faucetAmt - maxFee - amt)) ra2 - it "TRANS_CREATE_02 - Multiple Output Tx to single wallet" $ \ctx -> do + it "TRANS_CREATE_02 - Multiple Output Tx to single wallet" $ \ctx -> runResourceT @IO $ do wSrc <- fixtureWallet ctx wDest <- emptyWallet ctx addrs <- listAddresses @n ctx wDest @@ -261,7 +266,7 @@ spec = do (`shouldBe` Quantity (2*amt)) ] - it "TRANS_CREATE_04 - Can't cover fee" $ \ctx -> do + it "TRANS_CREATE_04 - Can't cover fee" $ \ctx -> runResourceT @IO $ do wDest <- fixtureWallet ctx let amt = (1 :: Natural) @@ -290,7 +295,7 @@ spec = do , expectErrorMessage errMsg403Fee ] - it "TRANS_CREATE_04 - Not enough money" $ \ctx -> do + it "TRANS_CREATE_04 - Not enough money" $ \ctx -> runResourceT @IO $ do let (srcAmt, reqAmt) = (1, 1_000_000) wSrc <- fixtureWalletWith @n ctx [srcAmt] wDest <- emptyWallet ctx @@ -315,24 +320,24 @@ spec = do , expectErrorMessage $ errMsg403NotEnoughMoney srcAmt reqAmt ] - it "TRANS_CREATE_09 - 0 amount transaction is accepted on single output tx" $ \ctx -> do + it "TRANS_CREATE_09 - 0 amount transaction is accepted on single output tx" $ \ctx -> runResourceT @IO $ do (wSrc, payload) <- fixtureZeroAmtSingle ctx r <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload expectResponseCode HTTP.status202 r - it "TRANS_CREATE_09 - 0 amount transaction is accepted on multi-output tx" $ \ctx -> do + it "TRANS_CREATE_09 - 0 amount transaction is accepted on multi-output tx" $ \ctx -> runResourceT @IO $ do (wSrc, payload) <- fixtureZeroAmtMulti ctx r <- request @(ApiTransaction n) ctx (Link.createTransaction @'Shelley wSrc) Default payload expectResponseCode HTTP.status202 r - it "TRANS_CREATE_10 - 'account' outputs" $ \ctx -> do + it "TRANS_CREATE_10 - 'account' outputs" $ \ctx -> runResourceT @IO $ do (wSrc, wDest) <- (,) <$> fixtureWallet ctx <*> emptyWallet ctx addrs <- listAddresses @n ctx wDest let hrp = [Bech32.humanReadablePart|addr|] - bytes <- generate (vector 32) + bytes <- liftIO $ generate (vector 32) let (utxoAmt, utxoAddr) = ( 14 :: Natural , (addrs !! 1) ^. #id @@ -394,30 +399,31 @@ spec = do ] it "TRANS_ESTIMATE_09 - \ - \a fee can be estimated for a tx with an output of amount 0 (single)" $ \ctx -> do + \a fee can be estimated for a tx with an output of amount 0 (single)" $ \ctx -> runResourceT @IO $ do (wSrc, payload) <- fixtureZeroAmtSingle ctx r <- request @ApiFee ctx (Link.getTransactionFee @'Shelley wSrc) Default payload expectResponseCode HTTP.status202 r it "TRANS_ESTIMATE_09 - \ - \a fee can be estimated for a tx with an output of amount 0 (multi)" $ \ctx -> do + \a fee can be estimated for a tx with an output of amount 0 (multi)" $ \ctx -> runResourceT @IO $ do (wSrc, payload) <- fixtureZeroAmtMulti ctx r <- request @ApiFee ctx (Link.getTransactionFee @'Shelley wSrc) Default payload expectResponseCode HTTP.status202 r - it "TRANS_LIST_?? - List transactions of a fixture wallet" $ \ctx -> do + it "TRANS_LIST_?? - List transactions of a fixture wallet" $ \ctx -> runResourceT @IO $ do txs <- fixtureWallet ctx >>= listAllTransactions @n ctx - length txs `shouldBe` 10 - txs `shouldSatisfy` all (null . view #inputs) + liftIO $ do + length txs `shouldBe` 10 + txs `shouldSatisfy` all (null . view #inputs) it "TRANS_EXTERNAL_CREATE_01x - \ - \single output tx signed via jcli" $ \ctx -> do + \single output tx signed via jcli" $ \ctx -> runResourceT @IO $ do w <- emptyWallet ctx addr:_ <- listAddresses @n ctx w let amt = 1234 - payload <- fixtureRawTx ctx (getApiT $ fst $ addr ^. #id, amt) + payload <- liftIO $ fixtureRawTx ctx (getApiT $ fst $ addr ^. #id, amt) let headers = Headers [ ("Content-Type", "application/octet-stream") , ("Accept", "application/json")] @@ -437,14 +443,14 @@ spec = do let txDeleteTest05 :: (HasType (ApiT WalletId) wal) => String - -> (Context t -> IO wal) + -> (Context t -> ResourceT IO wal) -> SpecWith (Context t) - txDeleteTest05 title eWallet = it title $ \ctx -> do + txDeleteTest05 title eWallet = it title $ \ctx -> runResourceT $ do -- post external tx wal <- emptyWallet ctx addr:_ <- listAddresses @n ctx wal let amt = 1234 - payload <- fixtureRawTx ctx (getApiT $ fst $ addr ^. #id, amt) + payload <- liftIO $ fixtureRawTx ctx (getApiT $ fst $ addr ^. #id, amt) let headers = Headers [ ("Content-Type", "application/octet-stream") , ("Accept", "application/json")] @@ -456,8 +462,8 @@ spec = do w <- eWallet ctx let ep = "v2/" <> T.pack title <> "/" <> w ^. walletId <> "/transactions/" <> txid - ra <- request @ApiTxId @IO ctx ("DELETE", ep) Default Empty - expectResponseCode @IO HTTP.status404 ra + ra <- request @ApiTxId ctx ("DELETE", ep) Default Empty + expectResponseCode HTTP.status404 ra expectErrorMessage (errMsg404CannotFindTx txid) ra -- tx eventually gets into ledger (funds are on the target wallet) @@ -473,7 +479,7 @@ spec = do txDeleteTest05 "byron-wallets" emptyRandomWallet it "TRANS_EXTERNAL_CREATE_01api - proper single output transaction and \ - \proper binary format" $ \ctx -> do + \proper binary format" $ \ctx -> runResourceT $ do let toSend = 1 :: Natural (ExternalTxFixture wSrc wDest fee bin _) <- fixtureExternalTx @n ctx toSend @@ -481,7 +487,7 @@ spec = do let encodedSignedTx = T.decodeUtf8 $ convertToBase baseOk bin let payload = NonJson . BL.fromStrict . toRawBytes baseOk let headers = Headers [ ("Content-Type", "application/octet-stream") ] - (initTotal, initAvailable) <- getWalletBalance ctx wDest + (initTotal, initAvailable) <- liftIO $ getWalletBalance ctx wDest r <- request @ApiTxId ctx Link.postExternalTransaction headers (payload encodedSignedTx) @@ -511,7 +517,7 @@ spec = do ] it "TRANS_EXTERNAL_CREATE_02 - proper single output transaction and \ - \improper binary format" $ \ctx -> do + \improper binary format" $ \ctx -> runResourceT $ do let toSend = 1 :: Natural (ExternalTxFixture _ _ _ bin _) <- fixtureExternalTx @n ctx toSend @@ -527,7 +533,7 @@ spec = do ] it "TRANS_EXTERNAL_CREATE_03 - proper single output transaction and \ - \wrong binary format" $ \ctx -> do + \wrong binary format" $ \ctx -> runResourceT @IO $ do let toSend = 1 :: Natural (ExternalTxFixture _ _ _ bin _) <- fixtureExternalTx @n ctx toSend let payload = NonJson $ BL.fromStrict $ ("\NUL\NUL"<>) $ getSealedTx bin @@ -538,7 +544,7 @@ spec = do , expectResponseCode HTTP.status400 ] - it "TRANS_EXTERNAL_CREATE_03 - empty payload" $ \ctx -> do + it "TRANS_EXTERNAL_CREATE_03 - empty payload" $ \ctx -> runResourceT @IO $ do _ <- emptyWallet ctx let headers = Headers [ ("Content-Type", "application/octet-stream") ] r <- request @ApiTxId ctx Link.postExternalTransaction headers Empty @@ -547,8 +553,8 @@ spec = do , expectResponseCode HTTP.status400 ] - it "BYRON_MIGRATE_07x - migrate to inaproppriate addresses" $ \ctx -> do - pendingWith "Pending due to\ + it "BYRON_MIGRATE_07x - migrate to inaproppriate addresses" $ \ctx -> runResourceT @IO $ do + liftIO $ pendingWith "Pending due to\ \ https://github.com/input-output-hk/cardano-wallet/issues/1658#issuecomment-632137152" let addrsInvalid :: [Text] = [ "DdzFFzCqrhtCNjPk5Lei7E1FxnoqMoAYtJ8VjAWbFmDb614nNBWBwv3kt6QHJa59cGezzf6piMWsbK7sWRB5sv325QqWdRuusMqqLdMt" @@ -564,7 +570,7 @@ spec = do , addresses: [#{addr}] }|]) verify r - [ expectResponseCode @IO HTTP.status400 + [ expectResponseCode HTTP.status400 , expectErrorMessage "Improper address. Make sure you are using valid Jörmungandr address." ] @@ -633,26 +639,25 @@ data ExternalTxFixture = ExternalTxFixture -- Most of this could be replaced with simple calls of the derivation primitives -- in AddressDerivation. fixtureExternalTx - :: forall n t. + :: forall n t . ( DecodeAddress n , DecodeStakeAddress n , DelegationAddress n JormungandrKey ) => (Context t) -> Natural - -> IO ExternalTxFixture + -> ResourceT IO ExternalTxFixture fixtureExternalTx ctx toSend = do -- we use faucet wallet as wSrc - mnemonicFaucet <- mnemonicToText <$> nextWallet @"shelley" (_faucet ctx) + mnemonicFaucet <- liftIO $ mnemonicToText <$> nextWallet @"shelley" (_faucet ctx) let restoreFaucetWallet = Json [json| { "name": "Faucet Wallet", "mnemonic_sentence": #{mnemonicFaucet}, "passphrase": #{fixturePassphrase} } |] - r0 <- request - @ApiWallet ctx ("POST", "v2/wallets") Default restoreFaucetWallet + r0 <- postWallet ctx restoreFaucetWallet verify r0 - [ expectResponseCode @IO HTTP.status201 + [ expectResponseCode HTTP.status201 , expectField (#name . #getApiT . #getWalletName) (`shouldBe` "Faucet Wallet") ] @@ -669,7 +674,7 @@ fixtureExternalTx ctx toSend = do let (Just keysAddrChng) = isOwned st' (rootXPrv, pwd) addrChng -- we create destination empty wallet - mnemonics15 <- genMnemonics M15 + mnemonics15 <- liftIO $ genMnemonics M15 let createWallet = Json [json| { "name": "Destination Wallet", "mnemonic_sentence": #{mnemonics15}, @@ -713,7 +718,7 @@ fixtureExternalTx ctx toSend = do , TxOut addrChng (Coin (fromIntegral $ amt - toSend - fee)) ] } - tl <- newTransactionLayer <$> getBlock0H + tl <- liftIO $ newTransactionLayer <$> getBlock0H let rewardAcnt = error "rewardAcnt unused" let curSlot = error "current slot not needed in jormungandr mkStdTx" let (Right (tx, bin)) = mkStdTx tl rewardAcnt keystore curSlot Nothing cs diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs index 9cd8953f1bf..b0a4fd71e57 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Launcher.hs @@ -148,7 +148,7 @@ spec = do , "--secret", secret , "--config", config ] - (Exit c, Stdout _, Stderr e) <- cardanoWalletCLI @t args + (Exit c, Stdout _, Stderr e) <- cardanoWalletCLI @t @_ @IO args c `shouldBe` ExitFailure 1 e `shouldContain` ("I couldn't find any file at the given location: " <> block0') @@ -161,7 +161,7 @@ spec = do , "--secret", secret , "--config", config ] - (Exit c, Stdout _, Stderr _) <- cardanoWalletCLI @t args + (Exit c, Stdout _, Stderr _) <- cardanoWalletCLI @t @_ @IO args c `shouldBe` ExitFailure 33 -- FIXME: https://github.com/input-output-hk/cardano-wallet/issues/2187 -- o `shouldContain` @@ -174,7 +174,7 @@ spec = do , "--" , "--rest-listen", "127.0.0.1:8080" ] - (Exit c, Stdout _, Stderr e) <- cardanoWalletCLI @t args + (Exit c, Stdout _, Stderr e) <- cardanoWalletCLI @t @_ @IO args c `shouldBe` ExitFailure 1 e `shouldContain` "The --rest-listen option is used by the 'launch' command." @@ -186,7 +186,7 @@ spec = do , "--" , "--storage", "/tmp/whatever" ] - (Exit c, Stdout _, Stderr e) <- cardanoWalletCLI @t args + (Exit c, Stdout _, Stderr e) <- cardanoWalletCLI @t @_ @IO args c `shouldBe` ExitFailure 1 e `shouldContain` "The --storage option is used by the 'launch' command." diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Port.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Port.hs index dab82e379e3..969b7be6aa1 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Port.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Port.hs @@ -42,7 +42,7 @@ spec = do ] forM_ tests $ \(cmd, opt, port) -> let args = [cmd, opt, show port] in it (unwords args) $ \_ -> do - (exit, Stdout (_ :: String), Stderr err) <- cardanoWalletCLI @t args + (exit, Stdout (_ :: String), Stderr err) <- cardanoWalletCLI @t @_ @IO args exit `shouldBe` ExitFailure 1 err `shouldContain` ( "expected a TCP port number between " diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Server.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Server.hs index def7e17a3e4..6bf90a80e7d 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Server.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Server.hs @@ -186,7 +186,7 @@ spec = do , "--genesis-block-hash" , hash ] - (Exit c, Stdout o, Stderr e) <- cardanoWalletCLI @t args + (Exit c, Stdout o, Stderr e) <- cardanoWalletCLI @t @_ @IO args c `shouldBe` ExitFailure 1 o `shouldBe` mempty e `shouldContain` @@ -199,7 +199,7 @@ spec = do , "--genesis-block-hash" , replicate 37 '1' ] - (Exit c, Stdout o, Stderr e) <- cardanoWalletCLI @t args + (Exit c, Stdout o, Stderr e) <- cardanoWalletCLI @t @_ @IO args c `shouldBe` ExitFailure 1 o `shouldBe` mempty e `shouldContain` diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/StakePools.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/StakePools.hs index 62895f8e22e..d468fa74972 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/StakePools.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/StakePools.hs @@ -21,8 +21,11 @@ spec :: forall t. (KnownCommand t) => SpecWith (Context t) spec = do - it "STAKE_POOLS_LIST_01 - List stake pools" $ \ctx -> do + it "STAKE_POOLS_LIST_01 - List stake pools" $ \ctx -> inIO $ do eventually "Stake pools are listed" $ do (Exit c, Stdout _, Stderr e) <- listStakePoolsViaCLI @t ctx e `shouldBe` "Ok.\n" c `shouldBe` ExitSuccess + where + inIO :: IO a -> IO a + inIO = id diff --git a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs index 47cd945decb..9ae8d030a85 100644 --- a/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs +++ b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/CLI/Transactions.hs @@ -25,6 +25,8 @@ import Cardano.Wallet.Primitive.AddressDerivation.Jormungandr ( JormungandrKey ) import Cardano.Wallet.Primitive.Types ( Hash (..), Tx (..) ) +import Control.Monad.IO.Class + ( liftIO ) import Data.ByteArray.Encoding ( Base (Base16, Base64), convertToBase ) import Data.Generics.Internal.VL.Lens @@ -55,6 +57,7 @@ import Test.Integration.Framework.DSL , getWalletViaCLI , listAddresses , postExternalTransactionViaCLI + , runResourceT , verify , walletId ) @@ -81,19 +84,20 @@ spec :: forall n t. ) => SpecWith (Context t) spec = do it "TRANS_EXTERNAL_CREATE_01x - \ - \single output tx signed via jcli" $ \ctx -> do + \single output tx signed via jcli" $ \ctx -> runResourceT @IO $ do w <- emptyWallet ctx addr:_ <- listAddresses @n ctx w let amt = 4321 - payload <- fixtureRawTx ctx (getApiT $ fst $ addr ^. #id, amt) + payload <- liftIO $ fixtureRawTx ctx (getApiT $ fst $ addr ^. #id, amt) (Exit code, Stdout out, Stderr err) <- postExternalTransactionViaCLI @t ctx [T.unpack $ T.decodeUtf8 $ hex $ BL.toStrict payload] - err `shouldBe` "Ok.\n" - out `shouldContain` "id" - code `shouldBe` ExitSuccess - eventually ("Wallet's balance is as expected = " ++ show amt) $ do + liftIO $ do + err `shouldBe` "Ok.\n" + out `shouldContain` "id" + code `shouldBe` ExitSuccess + liftIO $ eventually ("Wallet's balance is as expected = " ++ show amt) $ do Stdout gOutDest <- getWalletViaCLI @t ctx (T.unpack (w ^. walletId)) destJson <- expectValidJSON (Proxy @ApiWallet) gOutDest @@ -107,14 +111,14 @@ spec = do ] it "TRANS_EXTERNAL_CREATE_01cli - proper single output transaction and \ - \proper binary format" $ \ctx -> do + \proper binary format" $ \ctx -> runResourceT @IO $ do let toSend = 1 :: Natural (ExternalTxFixture _ wDest _ bin tx) <- fixtureExternalTx @n @t ctx toSend let baseOk = Base16 let arg = B8.unpack $ convertToBase baseOk bin let expectedTxId = T.decodeUtf8 $ hex . getHash $ txId tx - (initTotal, initAvailable) <- getWalletBalance ctx wDest + (initTotal, initAvailable) <- liftIO $ getWalletBalance ctx wDest -- post external transaction (Exit code, Stdout out, Stderr err) <- @@ -149,7 +153,7 @@ spec = do ] it "TRANS_EXTERNAL_CREATE_02 - proper single output transaction and \ - \not hex-encoded binary format" $ \ctx -> do + \not hex-encoded binary format" $ \ctx -> runResourceT @IO $ do let toSend = 1 :: Natural (ExternalTxFixture _ _ _ bin _) <- fixtureExternalTx @n @t ctx toSend let baseWrong = Base64 @@ -157,36 +161,38 @@ spec = do -- post external transaction (Exit code1, Stdout out1, Stderr err1) <- postExternalTransactionViaCLI @t ctx [argWrong] - err1 `shouldContain` errMsg400WronglyEncodedTxPayload - out1 `shouldBe` "" - code1 `shouldBe` ExitFailure 1 + liftIO $ do + err1 `shouldContain` errMsg400WronglyEncodedTxPayload + out1 `shouldBe` "" + code1 `shouldBe` ExitFailure 1 it "TRANS_EXTERNAL_CREATE_03 - proper single output transaction and \ - \wrong binary format" $ \ctx -> do + \wrong binary format" $ \ctx -> runResourceT @IO $ do let invalidArg = "0000" (Exit code, Stdout out, Stderr err) <- postExternalTransactionViaCLI @t ctx [invalidArg] - err `shouldContain` errMsg400MalformedTxPayload - out `shouldBe` mempty - code `shouldBe` ExitFailure 1 + liftIO $ do + err `shouldContain` errMsg400MalformedTxPayload + out `shouldBe` mempty + code `shouldBe` ExitFailure 1 - it "TRANS_DELETE_05 - Cannot forget external tx via CLI" $ \ctx -> do + it "TRANS_DELETE_05 - Cannot forget external tx via CLI" $ \ctx -> runResourceT @IO $ do w <- emptyWallet ctx addr:_ <- listAddresses @n ctx w let amt = 11111 -- post external tx - payload <- fixtureRawTx ctx (getApiT $ fst $ addr ^. #id, amt) + payload <- liftIO $ fixtureRawTx ctx (getApiT $ fst $ addr ^. #id, amt) (Exit code, Stdout out, Stderr err) <- postExternalTransactionViaCLI @t ctx [T.unpack $ T.decodeUtf8 $ hex $ BL.toStrict payload] - err `shouldBe` "Ok.\n" + liftIO $ err `shouldBe` "Ok.\n" txJson <- expectValidJSON (Proxy @ApiTxId) out - code `shouldBe` ExitSuccess + liftIO $ code `shouldBe` ExitSuccess let txid = T.unpack $ toUrlPiece (txJson ^. #id) -- funds eventually are on target wallet - eventually "Wallet balance is as expected" $ do + liftIO $ eventually "Wallet balance is as expected" $ do Stdout gOutDest <- getWalletViaCLI @t ctx (T.unpack (w ^. walletId)) destJson <- expectValidJSON (Proxy @ApiWallet) gOutDest @@ -200,6 +206,7 @@ spec = do -- Try to forget external tx (Exit c2, Stdout out2, Stderr err2) <- deleteTransactionViaCLI @t ctx (T.unpack $ w ^. walletId) txid - err2 `shouldContain` errMsg403NoPendingAnymore (T.pack txid) - out2 `shouldBe` "" - c2 `shouldBe` ExitFailure 1 + liftIO $ do + err2 `shouldContain` errMsg403NoPendingAnymore (T.pack txid) + out2 `shouldBe` "" + c2 `shouldBe` ExitFailure 1 diff --git a/lib/shelley/bench/Latency.hs b/lib/shelley/bench/Latency.hs index 54b3645407c..7d41807d57e 100644 --- a/lib/shelley/bench/Latency.hs +++ b/lib/shelley/bench/Latency.hs @@ -80,6 +80,8 @@ import Control.Concurrent.STM.TVar ( TVar ) import Control.Monad ( mapM_, replicateM, replicateM_ ) +import Control.Monad.IO.Class + ( liftIO ) import Data.Generics.Internal.VL.Lens ( (^.) ) import Data.Proxy @@ -118,6 +120,7 @@ import Test.Integration.Framework.DSL , json , minUTxOValue , request + , runResourceT , unsafeRequest , verify ) @@ -241,7 +244,7 @@ walletApiBench capture ctx = do rStat <- request @ApiUtxoStatistics ctx (Link.getUTxOsStatistics @'Shelley wal1) Default Empty - expectResponseCode @IO HTTP.status200 rStat + expectResponseCode HTTP.status200 rStat expectWalletUTxO (fromIntegral <$> utxoExp) (snd rStat) pure (wal1, wal2) @@ -258,7 +261,7 @@ walletApiBench capture ctx = do (`shouldBe` amtExp) ] rDel <- request @ApiWallet ctx (Link.deleteWallet @'Shelley wSrc) Default Empty - expectResponseCode @IO HTTP.status204 rDel + expectResponseCode HTTP.status204 rDel pure () postTx (wSrc, postTxEndp, pass) wDest amt = do @@ -279,9 +282,7 @@ walletApiBench capture ctx = do expectResponseCode HTTP.status202 r return r - runScenario scenario = do - (wal1, wal2) <- scenario - + runScenario scenario = runResourceT $ scenario >>= \(wal1, wal2) -> liftIO $ do t1 <- measureApiLogs capture (request @[ApiWallet] ctx (Link.listWallets @'Shelley) Default Empty) fmtResult "listWallets " t1 diff --git a/lib/shelley/cardano-wallet.cabal b/lib/shelley/cardano-wallet.cabal index d5990dfed9b..bab5437bdd9 100644 --- a/lib/shelley/cardano-wallet.cabal +++ b/lib/shelley/cardano-wallet.cabal @@ -191,7 +191,6 @@ test-suite integration ghc-options: -O2 -Werror build-depends: base - , aeson , async , cardano-api , cardano-wallet-cli diff --git a/lib/shelley/test/integration/Main.hs b/lib/shelley/test/integration/Main.hs index 47125ba5335..01edc9b2dc1 100644 --- a/lib/shelley/test/integration/Main.hs +++ b/lib/shelley/test/integration/Main.hs @@ -30,7 +30,7 @@ import Cardano.Startup import Cardano.Wallet.Api.Server ( Listen (..) ) import Cardano.Wallet.Api.Types - ( ApiByronWallet, ApiWallet, EncodeAddress (..), WalletStyle (..) ) + ( EncodeAddress (..) ) import Cardano.Wallet.Logging ( BracketLog (..), bracketTracer, trMessageText ) import Cardano.Wallet.Network.Ports @@ -71,8 +71,6 @@ import Control.Concurrent.MVar ( newEmptyMVar, putMVar, takeMVar ) import Control.Exception ( throwIO ) -import Control.Monad - ( forM_, void ) import Control.Monad.IO.Class ( liftIO ) import Control.Tracer @@ -102,7 +100,7 @@ import System.FilePath import System.IO ( BufferMode (..), hSetBuffering, stdout ) import Test.Hspec - ( Spec, SpecWith, after, describe, hspec, parallel ) + ( Spec, SpecWith, describe, hspec, parallel ) import Test.Hspec.Extra ( aroundAll ) import Test.Integration.Faucet @@ -110,12 +108,10 @@ import Test.Integration.Faucet import Test.Integration.Framework.Context ( Context (..), PoolGarbageCollectionEvent (..) ) import Test.Integration.Framework.DSL - ( Headers (..), KnownCommand (..), Payload (..), request, unsafeRequest ) + ( KnownCommand (..) ) import qualified Cardano.Pool.DB as Pool import qualified Cardano.Pool.DB.Sqlite as Pool -import qualified Cardano.Wallet.Api.Link as Link -import qualified Data.Aeson as Aeson import qualified Data.Text as T import qualified Test.Integration.Scenario.API.Byron.Addresses as ByronAddresses import qualified Test.Integration.Scenario.API.Byron.HWWallets as ByronHWWallets @@ -187,7 +183,7 @@ specWithServer :: (Tracer IO TestsLog, Tracers IO) -> SpecWith (Context Shelley) -> Spec -specWithServer (tr, tracers) = aroundAll withContext . after tearDown +specWithServer (tr, tracers) = aroundAll withContext where withContext :: (Context Shelley -> IO ()) -> IO () withContext action = bracketTracer' tr "withContext" $ do @@ -290,18 +286,6 @@ specWithServer (tr, tracers) = aroundAll withContext . after tearDown (gp, vData) (action gp) - -- | teardown after each test (currently only deleting all wallets) - tearDown :: Context t -> IO () - tearDown ctx = bracketTracer' tr "tearDown" $ do - (_, byronWallets) <- unsafeRequest @[ApiByronWallet] ctx - (Link.listWallets @'Byron) Empty - forM_ byronWallets $ \w -> void $ request @Aeson.Value ctx - (Link.deleteWallet @'Byron w) Default Empty - (_, wallets) <- unsafeRequest @[ApiWallet] ctx - (Link.listWallets @'Shelley) Empty - forM_ wallets $ \w -> void $ request @Aeson.Value ctx - (Link.deleteWallet @'Shelley w) Default Empty - {------------------------------------------------------------------------------- Logging -------------------------------------------------------------------------------} diff --git a/nix/.stack.nix/cardano-wallet-core-integration.nix b/nix/.stack.nix/cardano-wallet-core-integration.nix index eea298c0f13..b0a2a20b13d 100644 --- a/nix/.stack.nix/cardano-wallet-core-integration.nix +++ b/nix/.stack.nix/cardano-wallet-core-integration.nix @@ -64,6 +64,7 @@ (hsPkgs."memory" or (errorHandler.buildDepError "memory")) (hsPkgs."optparse-applicative" or (errorHandler.buildDepError "optparse-applicative")) (hsPkgs."process" or (errorHandler.buildDepError "process")) + (hsPkgs."resourcet" or (errorHandler.buildDepError "resourcet")) (hsPkgs."retry" or (errorHandler.buildDepError "retry")) (hsPkgs."say" or (errorHandler.buildDepError "say")) (hsPkgs."scrypt" or (errorHandler.buildDepError "scrypt"))