From 2883765faeb1500f00401a79b0575429e21ebb1e Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Tue, 5 Nov 2019 20:01:03 +0100 Subject: [PATCH 1/5] DSL updates for join/quit stake pools --- .../src/Test/Integration/Framework/DSL.hs | 82 +++++++++++++++++++ 1 file changed, 82 insertions(+) diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 807b88d2235..0842c14bf12 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 @@ -103,6 +105,8 @@ module Test.Integration.Framework.DSL , eventually , eventuallyUsingDelay , fixturePassphrase + , eventually' + , eventuallyUsingDelay' -- * Endpoints , postByronWalletEp @@ -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 @@ -870,6 +878,31 @@ eventuallyUsingDelay delay io = do threadDelay delay trial +-- similar as @eventually@ but returns IO a +eventually' + :: IO a + -> IO a +eventually' = eventuallyUsingDelay' (500 * ms) + where + ms = 1000 + +-- similar as @eventuallyUsingDelay@ but returns IO a +eventuallyUsingDelay' + :: Int + -> IO a + -> IO a +eventuallyUsingDelay' delay io = do + winner <- race (threadDelay $ 60 * oneSecond) trial + case winner of + Left _ -> fail + "waited more than 60s for action to eventually resolve." + Right a -> + return a + where + trial = io `catch` \(_ :: SomeException) -> do + threadDelay delay + trial + utcIso8601ToText :: UTCTime -> Text utcIso8601ToText = utcTimeToText iso8601ExtendedUtc @@ -1058,6 +1091,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 [ApiStakePool]) +joinStakePool ctx p (w, pass) = do + let payload = Json [aesonQQ| { + "passphrase": #{pass} + } |] + request @[ApiStakePool] ctx (joinStakePoolEp p w) Default payload + +quitStakePool + :: forall t w. (HasType (ApiT WalletId) w) + => Context t + -> ApiStakePool + -> (w, Text) + -> IO (HTTP.Status, Either RequestException [ApiStakePool]) +quitStakePool ctx p (w, pass) = do + let payload = Json [aesonQQ| { + "passphrase": #{pass} + } |] + request @[ApiStakePool] ctx (quitStakePoolEp p w) Default payload + listAddresses :: Context t -> ApiWallet @@ -1234,6 +1291,31 @@ 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" From 97ea63550a0ff0e2812bc9d9d92b7acd16e29347 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Tue, 5 Nov 2019 20:01:31 +0100 Subject: [PATCH 2/5] Preliminary integration tests for stub join/quit stake pool endpoints --- .../src/Test/Integration/Framework/DSL.hs | 2 +- .../Jormungandr/Scenario/API/StakePools.hs | 100 +++++++++++++++++- 2 files changed, 100 insertions(+), 2 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 0842c14bf12..232f1bde64c 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -1299,7 +1299,7 @@ stakePoolEp -> (Method, Text) stakePoolEp verb p w = ( verb - , "v2/stake-pools/" <> (toText $ getApiT $ p ^. #id) <> "/wallets/" <> w ^. walletId + , "v2/stake-pools/" <> toText (getApiT $ p ^. #id) <> "/wallets/" <> w ^. walletId ) joinStakePoolEp 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..4c18bdc3da6 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,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -21,22 +22,29 @@ import Test.Integration.Framework.DSL , Payload (..) , apparentPerformance , blocks + , emptyByronWallet + , emptyWallet , eventually + , eventually' , eventuallyUsingDelay , expectErrorMessage , expectListItemFieldBetween , expectListItemFieldEqual , expectListSizeEqual , expectResponseCode + , joinStakePool , listStakePoolsEp , metrics + , quitStakePool , request , stake + , unsafeRequest , verify ) import Test.Integration.Framework.TestData - ( errMsg405 ) + ( errMsg405, passphraseMaxLength, passphraseMinLength ) +import qualified Data.Text as T import qualified Network.HTTP.Types.Status as HTTP spec :: forall t. SpecWith (Context t) @@ -99,3 +107,93 @@ spec = do 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_02 - 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_02 - 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_03 - 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_03 - 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) -> it ("Join: " ++ expec) $ \ctx -> do + verifyIt ctx joinStakePool passphrase expec + + forM_ tests $ \(expec, passphrase) -> it ("Quit: " ++ expec) $ \ctx -> do + verifyIt ctx quitStakePool passphrase expec + + it "STAKE_POOLS_JOIN_04 - 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 + + 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_03 - 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 From ad3cd33cd2e0522c96829b7c0584e75a86965236 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Wed, 6 Nov 2019 15:44:47 +0100 Subject: [PATCH 3/5] indentation fixes --- .../Jormungandr/Scenario/API/StakePools.hs | 46 ++++++++++++------- 1 file changed, 29 insertions(+), 17 deletions(-) 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 4c18bdc3da6..edf0466f7b3 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 @@ -109,14 +109,16 @@ spec = do expectErrorMessage errMsg405 r it "STAKE_POOLS_JOIN_01 - Can join a stakepool" $ \ctx -> do - (_, p:_) <- eventually' $ unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + (_, 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_02 - 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 + (_, p1:p2:_) <- eventually' $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty w <- emptyWallet ctx r1 <- joinStakePool ctx p1 (w, "Secure Passprase") expectResponseCode HTTP.status501 r1 @@ -125,7 +127,8 @@ spec = do expectResponseCode HTTP.status501 r2 it "STAKE_POOLS_JOIN_02 - I definitely can quit and join another" $ \ctx -> do - (_, p1:p2:_) <- eventually' $ unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + (_, p1:p2:_) <- eventually' $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty w <- emptyWallet ctx r1 <- joinStakePool ctx p1 (w, "Secure Passprase") expectResponseCode HTTP.status501 r1 @@ -137,18 +140,21 @@ spec = do expectResponseCode HTTP.status501 r2 it "STAKE_POOLS_JOIN_03 - Passphrase must be correct to join" $ \ctx -> do - (_, p:_) <- eventually' $ unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + (_, 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_03 - Passphrase must have appropriate length" $ do + describe "STAKE_POOLS_JOIN/QUIT_03 -\ + \ 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 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') @@ -161,20 +167,24 @@ spec = do expectResponseCode HTTP.status400 r expectErrorMessage expec r - forM_ tests $ \(expec, passphrase) -> it ("Join: " ++ expec) $ \ctx -> do - verifyIt ctx joinStakePool passphrase expec + forM_ tests $ \(expec, passphrase) -> + it ("Join: " ++ expec) $ \ctx -> do + verifyIt ctx joinStakePool passphrase expec - forM_ tests $ \(expec, passphrase) -> it ("Quit: " ++ expec) $ \ctx -> do - verifyIt ctx quitStakePool passphrase expec + forM_ tests $ \(expec, passphrase) -> + it ("Quit: " ++ expec) $ \ctx -> do + verifyIt ctx quitStakePool passphrase expec it "STAKE_POOLS_JOIN_04 - Byron wallet cannot join stake pool" $ \ctx -> do - (_, p:_) <- eventually' $ unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + (_, p:_) <- eventually' $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty w <- emptyByronWallet ctx r <- joinStakePool ctx p (w, "Secure Passprase") expectResponseCode HTTP.status501 r it "STAKE_POOLS_QUIT_01 - Can quit stake pool" $ \ctx -> do - (_, p:_) <- eventually' $ unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + (_, p:_) <- eventually' $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty w <- emptyWallet ctx r <- joinStakePool ctx p (w, "Secure Passprase") expectResponseCode HTTP.status501 r @@ -183,14 +193,16 @@ spec = do expectResponseCode HTTP.status501 rq it "STAKE_POOLS_QUIT_01 - Quiting before even joining" $ \ctx -> do - (_, p:_) <- eventually' $ unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + (_, 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_03 - Passphrase must be correct to quit" $ \ctx -> do - (_, p:_) <- eventually' $ unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty + (_, p:_) <- eventually' $ + unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty w <- emptyWallet ctx joinStakePool ctx p (w, "Secure Passprase") >>= (expectResponseCode HTTP.status501) From b5adf2f8077f002886047732c13ba510aa7fafb1 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Wed, 6 Nov 2019 17:13:13 +0100 Subject: [PATCH 4/5] refactor eventually/eventually' into eventually_/eventually --- .../src/Test/Integration/Framework/DSL.hs | 63 +++---- .../Integration/Scenario/API/ByronWallets.hs | 8 +- .../Test/Integration/Scenario/API/Network.hs | 8 +- .../Integration/Scenario/API/Transactions.hs | 10 +- .../Integration/Scenario/CLI/Transactions.hs | 8 +- .../Jormungandr/Scenario/API/StakePools.hs | 158 +++++++++++++++--- 6 files changed, 172 insertions(+), 83 deletions(-) diff --git a/lib/core-integration/src/Test/Integration/Framework/DSL.hs b/lib/core-integration/src/Test/Integration/Framework/DSL.hs index 232f1bde64c..8b9f8b5ff64 100644 --- a/lib/core-integration/src/Test/Integration/Framework/DSL.hs +++ b/lib/core-integration/src/Test/Integration/Framework/DSL.hs @@ -104,9 +104,9 @@ module Test.Integration.Framework.DSL , prepExternalTxViaJcli , eventually , eventuallyUsingDelay + , eventually_ + , eventuallyUsingDelay_ , fixturePassphrase - , eventually' - , eventuallyUsingDelay' -- * Endpoints , postByronWalletEp @@ -844,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 @@ -863,35 +860,9 @@ eventually = eventuallyUsingDelay (500 * ms) -- It sleeps for a specified delay between retries. eventuallyUsingDelay :: Int -- ^ Delay in microseconds - -> IO () - -> IO () -eventuallyUsingDelay delay io = do - winner <- race (threadDelay $ 60 * oneSecond) trial - case winner of - Left _ -> expectationFailure - "waited more than 60s for action to eventually resolve." - Right _ -> - return () - where - trial :: IO () - trial = io `catch` \(_ :: SomeException) -> do - threadDelay delay - trial - --- similar as @eventually@ but returns IO a -eventually' - :: IO a - -> IO a -eventually' = eventuallyUsingDelay' (500 * ms) - where - ms = 1000 - --- similar as @eventuallyUsingDelay@ but returns IO a -eventuallyUsingDelay' - :: Int -> IO a -> IO a -eventuallyUsingDelay' delay io = do +eventuallyUsingDelay delay io = do winner <- race (threadDelay $ 60 * oneSecond) trial case winner of Left _ -> fail @@ -903,6 +874,17 @@ eventuallyUsingDelay' delay io = 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 @@ -1096,24 +1078,24 @@ joinStakePool => Context t -> ApiStakePool -> (w, Text) - -> IO (HTTP.Status, Either RequestException [ApiStakePool]) + -> IO (HTTP.Status, Either RequestException (ApiTransaction 'Testnet)) joinStakePool ctx p (w, pass) = do let payload = Json [aesonQQ| { "passphrase": #{pass} } |] - request @[ApiStakePool] ctx (joinStakePoolEp p w) Default payload + 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 [ApiStakePool]) + -> IO (HTTP.Status, Either RequestException (ApiTransaction 'Testnet)) quitStakePool ctx p (w, pass) = do let payload = Json [aesonQQ| { "passphrase": #{pass} } |] - request @[ApiStakePool] ctx (quitStakePoolEp p w) Default payload + request @(ApiTransaction 'Testnet) ctx (quitStakePoolEp p w) Default payload listAddresses :: Context t @@ -1299,7 +1281,10 @@ stakePoolEp -> (Method, Text) stakePoolEp verb p w = ( verb - , "v2/stake-pools/" <> toText (getApiT $ p ^. #id) <> "/wallets/" <> w ^. walletId + , "v2/stake-pools/" + <> toText (getApiT $ p ^. #id) + <> "/wallets/" + <> w ^. walletId ) joinStakePoolEp 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/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs b/lib/jormungandr/test/integration/Test/Integration/Jormungandr/Scenario/API/StakePools.hs index edf0466f7b3..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 @@ -3,6 +3,7 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} +{-# LANGUAGE TypeFamilies #-} module Test.Integration.Jormungandr.Scenario.API.StakePools ( spec @@ -11,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 @@ -25,32 +28,41 @@ import Test.Integration.Framework.DSL , emptyByronWallet , emptyWallet , eventually - , 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, passphraseMaxLength, passphraseMinLength ) + ( 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, @@ -92,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 @@ -104,20 +116,21 @@ 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' $ + (_, 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_02 - I cannot join another until I quit\ + 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' $ + (_, p1:p2:_) <- eventually $ unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty w <- emptyWallet ctx r1 <- joinStakePool ctx p1 (w, "Secure Passprase") @@ -126,8 +139,9 @@ spec = do r2 <- joinStakePool ctx p2 (w, "Secure Passprase") expectResponseCode HTTP.status501 r2 - it "STAKE_POOLS_JOIN_02 - I definitely can quit and join another" $ \ctx -> do - (_, p1:p2:_) <- eventually' $ + 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") @@ -139,51 +153,141 @@ spec = do r2 <- joinStakePool ctx p2 (w, "Secure Passprase") expectResponseCode HTTP.status501 r2 - it "STAKE_POOLS_JOIN_03 - Passphrase must be correct to join" $ \ctx -> do - (_, p:_) <- eventually' $ + 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_03 -\ + 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" + "passphrase is too short: expected at least 10 characters" let tooLong = - "passphrase is too long: expected at most 255 characters" + "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 + (_, 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) -> + forM_ tests $ \(expec, passphrase) -> do it ("Join: " ++ expec) $ \ctx -> do verifyIt ctx joinStakePool passphrase expec - forM_ tests $ \(expec, passphrase) -> it ("Quit: " ++ expec) $ \ctx -> do verifyIt ctx quitStakePool passphrase expec - it "STAKE_POOLS_JOIN_04 - Byron wallet cannot join stake pool" $ \ctx -> do - (_, p:_) <- eventually' $ + 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' $ + (_, p:_) <- eventually $ unsafeRequest @[ApiStakePool] ctx listStakePoolsEp Empty w <- emptyWallet ctx r <- joinStakePool ctx p (w, "Secure Passprase") @@ -193,15 +297,15 @@ spec = do expectResponseCode HTTP.status501 rq it "STAKE_POOLS_QUIT_01 - Quiting before even joining" $ \ctx -> do - (_, p:_) <- eventually' $ + (_, 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_03 - Passphrase must be correct to quit" $ \ctx -> do - (_, p:_) <- eventually' $ + 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") From a3926035851cc5bcd9ea59895ea4bdfbc736c3f8 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Thu, 7 Nov 2019 10:07:21 +0100 Subject: [PATCH 5/5] update start_node helper script --- lib/jormungandr/test/data/jormungandr/start_node | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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