diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 807b88d2235..8b9f8b5ff64 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -82,6 +82,8 @@ module Test.Integration.Framework.DSL , getFromResponseList , getJormungandrBlock0H , json + , joinStakePool + , quitStakePool , listAddresses , listTransactions , listAllTransactions @@ -102,6 +104,8 @@ module Test.Integration.Framework.DSL , prepExternalTxViaJcli , eventually , eventuallyUsingDelay + , eventually_ + , eventuallyUsingDelay_ , fixturePassphrase -- * Endpoints @@ -119,6 +123,9 @@ module Test.Integration.Framework.DSL , getWalletUtxoEp , getAddressesEp , listStakePoolsEp + , joinStakePoolEp + , quitStakePoolEp + , stakePoolEp , postTxEp , postExternalTxEp , postTxFeeEp @@ -155,6 +162,7 @@ import Cardano.Wallet.Api.Types ( AddressAmount , ApiAddress , ApiByronWallet + , ApiStakePool , ApiStakePoolMetrics , ApiT (..) , ApiTransaction @@ -836,15 +844,12 @@ apparentPerformance = -- Helpers -- - -- Retry the given action a couple of time until it doesn't throw, or until it -- has been retried enough. -- --- It is like @eventuallyUsingDelay@, but with the default delay of 500 ms +-- It is like 'eventuallyUsingDelay', but with the default delay of 500 ms -- between retries. -eventually - :: IO () - -> IO () +eventually :: IO a -> IO a eventually = eventuallyUsingDelay (500 * ms) where ms = 1000 @@ -855,21 +860,31 @@ eventually = eventuallyUsingDelay (500 * ms) -- It sleeps for a specified delay between retries. eventuallyUsingDelay :: Int -- ^ Delay in microseconds - -> IO () - -> IO () + -> IO a + -> IO a eventuallyUsingDelay delay io = do winner <- race (threadDelay $ 60 * oneSecond) trial case winner of - Left _ -> expectationFailure + Left _ -> fail "waited more than 60s for action to eventually resolve." - Right _ -> - return () + Right a -> + return a where - trial :: IO () trial = io `catch` \(_ :: SomeException) -> do threadDelay delay trial +eventually_ :: IO () -> IO () +eventually_ = eventuallyUsingDelay_ (500 * ms) + where + ms = 1000 + +eventuallyUsingDelay_ + :: Int -- ^ Delay in microseconds + -> IO () + -> IO () +eventuallyUsingDelay_ = eventuallyUsingDelay + utcIso8601ToText :: UTCTime -> Text utcIso8601ToText = utcTimeToText iso8601ExtendedUtc @@ -1058,6 +1073,30 @@ getFromResponseList i getter (_, res) = case res of json :: QuasiQuoter json = aesonQQ +joinStakePool + :: forall t w. (HasType (ApiT WalletId) w) + => Context t + -> ApiStakePool + -> (w, Text) + -> IO (HTTP.Status, Either RequestException (ApiTransaction 'Testnet)) +joinStakePool ctx p (w, pass) = do + let payload = Json [aesonQQ| { + "passphrase": #{pass} + } |] + request @(ApiTransaction 'Testnet) ctx (joinStakePoolEp p w) Default payload + +quitStakePool + :: forall t w. (HasType (ApiT WalletId) w) + => Context t + -> ApiStakePool + -> (w, Text) + -> IO (HTTP.Status, Either RequestException (ApiTransaction 'Testnet)) +quitStakePool ctx p (w, pass) = do + let payload = Json [aesonQQ| { + "passphrase": #{pass} + } |] + request @(ApiTransaction 'Testnet) ctx (quitStakePoolEp p w) Default payload + listAddresses :: Context t -> ApiWallet @@ -1234,6 +1273,34 @@ listStakePoolsEp = , "v2/stake-pools" ) +stakePoolEp + :: forall w. (HasType (ApiT WalletId) w) + => Method + -> ApiStakePool + -> w + -> (Method, Text) +stakePoolEp verb p w = + ( verb + , "v2/stake-pools/" + <> toText (getApiT $ p ^. #id) + <> "/wallets/" + <> w ^. walletId + ) + +joinStakePoolEp + :: forall w. (HasType (ApiT WalletId) w) + => ApiStakePool + -> w + -> (Method, Text) +joinStakePoolEp = stakePoolEp "PUT" + +quitStakePoolEp + :: forall w. (HasType (ApiT WalletId) w) + => ApiStakePool + -> w + -> (Method, Text) +quitStakePoolEp = stakePoolEp "DELETE" + postWalletEp :: (Method, Text) postWalletEp = ( "POST" diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/ByronWallets.hs b/lib/core-integration/src/Test/Integration/Scenario/API/ByronWallets.hs index d13eba48941..24618f191b0 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/ByronWallets.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/ByronWallets.hs @@ -57,7 +57,7 @@ import Test.Integration.Framework.DSL , emptyByronWalletWith , emptyWallet , emptyWalletWith - , eventually + , eventually_ , expectErrorMessage , expectEventually , expectFieldEqual @@ -252,7 +252,7 @@ spec = do -- Check that funds become available in the target wallet: let expectedBalance = originalBalance - expectedFee - eventually $ do + eventually_ $ do r2 <- request @ApiWallet ctx (getWalletEp targetWallet) Default Empty verify r2 @@ -293,7 +293,7 @@ spec = do } |] (_, wOld) <- unsafeRequest @ApiByronWallet ctx postByronWalletEp payloadRestore - eventually $ do + eventually_ $ do request @ApiByronWallet ctx (getByronWalletEp wOld) Default @@ -326,7 +326,7 @@ spec = do -- Check that funds become available in the target wallet: let expectedBalance = originalBalance - expectedFee - eventually $ do + eventually_ $ do request @ApiWallet ctx (getWalletEp wNew) Default 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 214083520c3..430c21f6fbb 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Network.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Network.hs @@ -23,7 +23,7 @@ import Test.Integration.Framework.DSL , Payload (..) , emptyByronWallet , emptyWallet - , eventually + , eventually_ , expectErrorMessage , expectEventually' , expectFieldEqual @@ -45,14 +45,14 @@ import qualified Network.HTTP.Types.Status as HTTP spec :: forall t. SpecWith (Context t) spec = do it "NETWORK - Can query network information" $ \ctx -> do - eventually $ do + eventually_ $ do r <- request @ApiNetworkInformation ctx networkInfoEp Default Empty verify r [ expectFieldEqual syncProgress Ready ] it "NETWORK_SHELLEY - Wallet has the same tip as network/information" $ \ctx -> do let getNetworkInfo = request @ApiNetworkInformation ctx networkInfoEp Default Empty w <- emptyWallet ctx - eventually $ do + eventually_ $ do sync <- getNetworkInfo verify sync [ expectFieldEqual syncProgress Ready ] r <- getNetworkInfo @@ -68,7 +68,7 @@ spec = do it "NETWORK_BYRON - Byron wallet has the same tip as network/information" $ \ctx -> do let getNetworkInfo = request @ApiNetworkInformation ctx networkInfoEp Default Empty w <- emptyByronWallet ctx - eventually $ do + eventually_ $ do sync <- getNetworkInfo verify sync [ expectFieldEqual syncProgress Ready ] r <- getNetworkInfo diff --git a/lib/core-integration/src/Test/Integration/Scenario/API/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/API/Transactions.hs index be7ae2d52e6..705bf6638a4 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/API/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/API/Transactions.hs @@ -68,7 +68,7 @@ import Test.Integration.Framework.DSL , direction , emptyByronWallet , emptyWallet - , eventually + , eventually_ , expectErrorMessage , expectEventually , expectEventually' @@ -145,7 +145,7 @@ spec = do wSrc <- fixtureWalletWith ctx [5_000_000] wDest <- emptyWallet ctx - eventually $ do + eventually_ $ do -- Post Tx let amt = (1 :: Natural) r <- postTx ctx (wSrc, postTxEp ,"Secure Passphrase") wDest amt @@ -1670,7 +1670,7 @@ spec = do ] -- transaction eventually is in source wallet - eventually $ do + eventually_ $ do let ep = listTxEndpSrc wSrc mempty request @[ApiTransaction n] ctx ep Default Empty >>= flip verify [ expectListItemFieldEqual 0 direction Outgoing @@ -1678,7 +1678,7 @@ spec = do ] -- transaction eventually is in target wallet - eventually $ do + eventually_ $ do let ep = listTxEp wDest mempty request @[ApiTransaction n] ctx ep Default Empty >>= flip verify [ expectListItemFieldEqual 0 direction Incoming @@ -1709,7 +1709,7 @@ spec = do let txid = getFromResponse #id rTx -- Wait for the transaction to be accepted - eventually $ do + eventually_ $ do let ep = listTxEndp wSrc mempty request @([ApiTransaction n]) ctx ep Default Empty >>= flip verify [ expectListItemFieldEqual 0 direction Outgoing diff --git a/lib/core-integration/src/Test/Integration/Scenario/CLI/Transactions.hs b/lib/core-integration/src/Test/Integration/Scenario/CLI/Transactions.hs index ecf5fc33ba9..af18403b877 100644 --- a/lib/core-integration/src/Test/Integration/Scenario/CLI/Transactions.hs +++ b/lib/core-integration/src/Test/Integration/Scenario/CLI/Transactions.hs @@ -67,7 +67,7 @@ import Test.Integration.Framework.DSL , direction , emptyByronWallet , emptyWallet - , eventually + , eventually_ , expectCliFieldBetween , expectCliFieldEqual , expectCliListItemFieldEqual @@ -918,7 +918,7 @@ spec = do [ expectCliFieldEqual balanceAvailable faucetAmt ] - eventually $ do + eventually_ $ do (fromStdout <$> listTransactionsViaCLI @t ctx [wSrcId]) >>= expectValidJSON (Proxy @([ApiTransaction n])) >>= flip verify @@ -926,7 +926,7 @@ spec = do , expectCliListItemFieldEqual 0 status InLedger ] - eventually $ do + eventually_ $ do (fromStdout <$> listTransactionsViaCLI @t ctx [wDestId]) >>= expectValidJSON (Proxy @([ApiTransaction n])) >>= flip verify @@ -948,7 +948,7 @@ spec = do -- Wait for the transaction to be accepted let wSrcId = T.unpack $ wSrc ^. walletId - eventually $ do + eventually_ $ do (fromStdout <$> listTransactionsViaCLI @t ctx [wSrcId]) >>= expectValidJSON (Proxy @([ApiTransaction n])) >>= flip verify diff --git a/lib/jormungandr/test/data/jormungandr/start_node b/lib/jormungandr/test/data/jormungandr/start_node index 453750734d5..4a3739c5af4 100755 --- a/lib/jormungandr/test/data/jormungandr/start_node +++ b/lib/jormungandr/test/data/jormungandr/start_node @@ -1 +1 @@ -cardano-wallet-jormungandr launch --genesis-block block0.bin -- --secret secret.yaml +cardano-wallet-jormungandr launch --genesis-block block0.bin --node-port 8080 -- --secret secret.yaml --config config.yaml 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 90011e2bed8..bd189f91a78 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 @@ -1,7 +1,9 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} module Test.Integration.Jormungandr.Scenario.API.StakePools ( spec @@ -10,7 +12,9 @@ module Test.Integration.Jormungandr.Scenario.API.StakePools import Prelude import Cardano.Wallet.Api.Types - ( ApiStakePool ) + ( ApiStakePool, ApiTransaction ) +import Cardano.Wallet.Primitive.AddressDerivation + ( NetworkDiscriminant (..) ) import Control.Monad ( forM_ ) import Test.Hspec @@ -21,28 +25,44 @@ import Test.Integration.Framework.DSL , Payload (..) , apparentPerformance , blocks + , emptyByronWallet + , emptyWallet , eventually - , eventuallyUsingDelay + , eventuallyUsingDelay_ + , eventually_ , expectErrorMessage , expectListItemFieldBetween , expectListItemFieldEqual , expectListSizeEqual , expectResponseCode + , joinStakePool + , joinStakePoolEp + , json , listStakePoolsEp , metrics + , quitStakePool + , quitStakePoolEp , request , stake + , stakePoolEp + , unsafeRequest , verify ) import Test.Integration.Framework.TestData - ( errMsg405 ) + ( errMsg405 + , errMsg406 + , errMsg415 + , passphraseMaxLength + , passphraseMinLength + ) +import qualified Data.Text as T import qualified Network.HTTP.Types.Status as HTTP -spec :: forall t. SpecWith (Context t) +spec :: forall t n. (n ~ 'Testnet) => SpecWith (Context t) spec = do it "STAKE_POOLS_LIST_01 - List stake pools" $ \ctx -> do - eventually $ do + eventually_ $ do r <- request @[ApiStakePool] ctx listStakePoolsEp Default Empty expectResponseCode HTTP.status200 r -- With the current genesis.yaml we have 3 pools with 1 lovelace, @@ -84,7 +104,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) $ do + eventuallyUsingDelay_ (50*ms) $ do r <- request @[ApiStakePool] ctx listStakePoolsEp Default Empty verify r [ expectResponseCode HTTP.status503 @@ -96,6 +116,200 @@ spec = do describe "STAKE_POOLS_LIST_03 - v2/stake-pools - Methods Not Allowed" $ do let methods = ["POST", "PUT", "DELETE", "CONNECT", "TRACE", "OPTIONS"] forM_ methods $ \method -> it (show method) $ \ctx -> do - r <- request @ApiStakePool ctx (method, "v2/stake-pools") Default Empty + r <- request @ApiStakePool ctx + (method, "v2/stake-pools") Default Empty expectResponseCode @IO HTTP.status405 r expectErrorMessage errMsg405 r + + it "STAKE_POOLS_JOIN_01 - Can join a stakepool" $ \ctx -> do + (_, p:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + r <- joinStakePool ctx p (w, "Secure Passphrase") + expectResponseCode HTTP.status501 r + + it "STAKE_POOLS_JOIN_01 - I cannot join another until I quit\ + \ or maybe I will just re-join another?" $ \ctx -> do + (_, p1:p2:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + r1 <- joinStakePool ctx p1 (w, "Secure Passprase") + expectResponseCode HTTP.status501 r1 + + r2 <- joinStakePool ctx p2 (w, "Secure Passprase") + expectResponseCode HTTP.status501 r2 + + it "STAKE_POOLS_JOIN_01 - \ + \I definitely can quit and join another" $ \ctx -> do + (_, p1:p2:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + r1 <- joinStakePool ctx p1 (w, "Secure Passprase") + expectResponseCode HTTP.status501 r1 + + r1q <- quitStakePool ctx p1 (w, "Secure Passprase") + expectResponseCode HTTP.status501 r1q + + r2 <- joinStakePool ctx p2 (w, "Secure Passprase") + expectResponseCode HTTP.status501 r2 + + it "STAKE_POOLS_JOIN_02 - Passphrase must be correct to join" $ \ctx -> do + (_, p:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + r <- joinStakePool ctx p (w, "Incorrect Passphrase") + expectResponseCode HTTP.status501 r + + describe "STAKE_POOLS_JOIN/QUIT_02 -\ + \ Passphrase must have appropriate length" $ do + + let pMax = passphraseMaxLength + let pMin = passphraseMinLength + let tooShort = + "passphrase is too short: expected at least 10 characters" + let tooLong = + "passphrase is too long: expected at most 255 characters" + let tests = + [ (tooLong, replicate (pMax + 1) '1') + , (tooShort, replicate (pMin - 1) '1') + ] + let verifyIt ctx doStakePool pass expec = do + (_, p:_) <- eventually $ do + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + r <- doStakePool ctx p (w, T.pack pass) + expectResponseCode HTTP.status400 r + expectErrorMessage expec r + + forM_ tests $ \(expec, passphrase) -> do + it ("Join: " ++ expec) $ \ctx -> do + verifyIt ctx joinStakePool passphrase expec + + it ("Quit: " ++ expec) $ \ctx -> do + verifyIt ctx quitStakePool passphrase expec + + describe "STAKE_POOLS_JOIN/QUIT_02 - Passphrase must be text" $ do + let verifyIt ctx sPoolEndp = do + (_, p:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + let payload = Json [json| { + "passphrase": 123 + } |] + r <- request @(ApiTransaction n) ctx (sPoolEndp p w) + Default payload + expectResponseCode HTTP.status400 r + expectErrorMessage "expected Text, encountered Number" r + it "Join" $ \ctx -> do + verifyIt ctx joinStakePoolEp + it "Quit" $ \ctx -> do + verifyIt ctx quitStakePoolEp + + it "STAKE_POOLS_JOIN_03 - Byron wallet cannot join stake pool" $ \ctx -> do + (_, p:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyByronWallet ctx + r <- joinStakePool ctx p (w, "Secure Passprase") + expectResponseCode HTTP.status501 r + + describe "STAKE_POOLS_JOIN/QUIT_05 - Bad request" $ do + let verifyIt ctx sPoolEndp = do + (_, p:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + let payload = NonJson "{ passphrase: Secure Passphrase }" + r <- request @(ApiTransaction n) ctx (sPoolEndp p w) + Default payload + expectResponseCode HTTP.status400 r + + it "Join" $ \ctx -> do + verifyIt ctx joinStakePoolEp + it "Quit" $ \ctx -> do + verifyIt ctx quitStakePoolEp + + describe "STAKE_POOLS_JOIN/QUIT_05 - Methods Not Allowed" $ do + let methods = ["POST", "CONNECT", "TRACE", "OPTIONS"] + forM_ methods $ \method -> it ("Join: " ++ show method) $ \ctx -> do + (_, p:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + let payload = Json [json| { + "passphrase": "Secure Passphrase" + } |] + r <- request @(ApiTransaction n) ctx (stakePoolEp method p w) + Default payload + expectResponseCode HTTP.status405 r + expectErrorMessage errMsg405 r + + describe "STAKE_POOLS_JOIN/QUIT_05 - HTTP headers" $ do + let verifyIt ctx sPoolEndp headers expec = do + (_, p:_) <- eventually $ do + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + let payload = Json [json| { + "passphrase": "Secure Passphrase" + } |] + r <- request @(ApiTransaction n) ctx (sPoolEndp p w) + headers payload + verify r expec + + let payloadHeaderCases = + [ ( "No HTTP headers -> 415", None + , [ expectResponseCode @IO HTTP.status415 + , expectErrorMessage errMsg415 ] + ) + , ( "Accept: text/plain -> 406" + , Headers + [ ("Content-Type", "application/json") + , ("Accept", "text/plain") ] + , [ expectResponseCode @IO HTTP.status406 + , expectErrorMessage errMsg406 ] + ) + , ( "No Accept -> 202" + , Headers [ ("Content-Type", "application/json") ] + , [ expectResponseCode @IO HTTP.status501 ] + ) + , ( "No Content-Type -> 415" + , Headers [ ("Accept", "application/json") ] + , [ expectResponseCode @IO HTTP.status415 + , expectErrorMessage errMsg415 ] + ) + , ( "Content-Type: text/plain -> 415" + , Headers [ ("Content-Type", "text/plain") ] + , [ expectResponseCode @IO HTTP.status415 + , expectErrorMessage errMsg415 ] + ) + ] + forM_ payloadHeaderCases $ \(title, headers, expectations) -> do + it ("Join: " ++ title) $ \ctx -> do + verifyIt ctx joinStakePoolEp headers expectations + it ("Quit: " ++ title) $ \ctx -> do + verifyIt ctx quitStakePoolEp headers expectations + + it "STAKE_POOLS_QUIT_01 - Can quit stake pool" $ \ctx -> do + (_, p:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + r <- joinStakePool ctx p (w, "Secure Passprase") + expectResponseCode HTTP.status501 r + + rq <- quitStakePool ctx p (w, "Secure Passprase") + expectResponseCode HTTP.status501 rq + + it "STAKE_POOLS_QUIT_01 - Quiting before even joining" $ \ctx -> do + (_, p:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + + rq <- quitStakePool ctx p (w, "Secure Passprase") + expectResponseCode HTTP.status501 rq + + it "STAKE_POOLS_QUIT_02 - Passphrase must be correct to quit" $ \ctx -> do + (_, p:_) <- eventually $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + w <- emptyWallet ctx + joinStakePool ctx p (w, "Secure Passprase") + >>= (expectResponseCode HTTP.status501) + + r <- quitStakePool ctx p (w, "Incorrect Passphrase") + expectResponseCode HTTP.status501 r