From f00890c529fe485cdf1fa606fc3b869c49b2361a Mon Sep 17 00:00:00 2001 From: Johannes Lund Date: Thu, 1 Oct 2020 11:47:44 +0200 Subject: [PATCH] Fixup remaining compilation failures --- .../src/Test/Integration/Framework/DSL.hs | 6 +- lib/jormungandr/test/bench/Latency.hs | 18 ++-- .../Jormungandr/Scenario/API/Addresses.hs | 41 ++++---- .../Jormungandr/Scenario/API/StakePools.hs | 99 ++++++++++--------- .../Jormungandr/Scenario/API/Transactions.hs | 77 ++++++++------- .../Jormungandr/Scenario/CLI/Launcher.hs | 8 +- .../Jormungandr/Scenario/CLI/Port.hs | 2 +- .../Jormungandr/Scenario/CLI/Server.hs | 4 +- .../Jormungandr/Scenario/CLI/StakePools.hs | 5 +- .../Jormungandr/Scenario/CLI/Transactions.hs | 55 ++++++----- lib/shelley/bench/Latency.hs | 11 ++- 11 files changed, 177 insertions(+), 149 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 64b7d16f0af..6cff99e199c 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -146,6 +146,10 @@ module Test.Integration.Framework.DSL , postExternalTransactionViaCLI , deleteTransactionViaCLI , getTransactionViaCLI + + -- * Re-exports + , runResourceT + , ResourceT ) where import Cardano.CLI @@ -248,7 +252,7 @@ import Control.Monad.Fail import Control.Monad.IO.Class ( MonadIO, liftIO ) import Control.Monad.Trans.Resource - ( ResourceT, allocate ) + ( ResourceT, allocate, runResourceT ) import Control.Retry ( capDelay, constantDelay, retrying ) import Crypto.Hash 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