From 8d4965e4536f546ba626e832caf3a110e1ad37fd Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Wed, 10 Apr 2019 08:00:18 +0200 Subject: [PATCH 1/4] Create a wallet via API endpoint - integration test Create a wallet via API endpoint - scenario --- .weeder.yaml | 6 + cardano-wallet.cabal | 6 +- test/integration/Main.hs | 77 +------ .../Test/Integration/Framework/DSL.hs | 188 +++++++++++++++++- .../Test/Integration/Scenario/Wallets.hs | 60 ++++++ 5 files changed, 264 insertions(+), 73 deletions(-) create mode 100644 test/integration/Test/Integration/Scenario/Wallets.hs diff --git a/.weeder.yaml b/.weeder.yaml index 71c523a296c..fe675047e73 100644 --- a/.weeder.yaml +++ b/.weeder.yaml @@ -43,11 +43,17 @@ - - expectError - expectSuccess + - expectFieldEqual + - expectFieldNotEqual + - getFromResponse - module: - name: Test.Integration.Framework.Request - identifier: - ClientError - DecodeFailure + - Empty + - None + - NonJson - unsafeRequest - section: - name: test:unit diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index 236ea09c3b5..45a64014f02 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -191,19 +191,22 @@ test-suite integration build-depends: base , aeson + , aeson-qq , async , bytestring , cardano-wallet , cborg + , cryptonite , exceptions , fmt + , generic-lens , hspec , hspec-core , hspec-expectations-lifted , http-client , http-api-data , http-types - , aeson-qq + , lens , process , say , template-haskell @@ -223,6 +226,7 @@ test-suite integration Cardano.Launcher Test.Integration.Framework.DSL Test.Integration.Framework.Request + Test.Integration.Scenario.Wallets if os(windows) build-depends: Win32 other-modules: Cardano.Launcher.Windows diff --git a/test/integration/Main.hs b/test/integration/Main.hs index ebe3c83ff01..d3c516033e9 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -14,28 +14,18 @@ import Control.Concurrent.Async ( async, cancel, link ) import Control.Monad ( void ) -import Data.Aeson - ( Value ) import Data.Time ( addUTCTime, defaultTimeLocale, formatTime, getCurrentTime ) import Network.HTTP.Client ( defaultManagerSettings, newManager ) -import Network.HTTP.Types.Status - ( status200, status404, status405 ) import Test.Hspec - ( SpecWith, afterAll, beforeAll, describe, hspec, it, shouldBe ) + ( afterAll, beforeAll, describe, hspec ) import Test.Integration.Framework.DSL - ( Context (..) - , Headers (..) - , Payload (..) - , expectResponseCode - , json - , request - ) + ( Context (..) ) import qualified Cardano.Wallet.Network.HttpBridgeSpec as HttpBridge import qualified Cardano.WalletSpec as Wallet -import qualified Data.Text as T +import qualified Test.Integration.Scenario.Wallets as Wallets main :: IO () main = do @@ -44,10 +34,8 @@ main = do describe "Cardano.Wallet.Network.HttpBridge" HttpBridge.spec beforeAll startCluster $ afterAll killCluster $ do - describe "Integration test framework" dummySpec + describe "Wallets API endpoint tests" Wallets.spec - beforeAll dummySetup $ do - describe "Test response codes" respCodesSpec where -- Run a local cluster of cardano-sl nodes, a cardano-http-bridge on top and -- a cardano wallet server connected to the bridge. @@ -66,6 +54,7 @@ main = do link cluster let baseURL = "http://localhost:1337/" manager <- newManager defaultManagerSettings + threadDelay 6000000 return $ Context cluster (baseURL, manager) killCluster :: Context -> IO () @@ -88,58 +77,8 @@ main = do cardanoWalletLauncher serverPort bridgePort network = Command "cardano-wallet-launcher" - [ "--wallet-server-port", serverPort + [ "--network", network + , "--wallet-server-port", serverPort , "--http-bridge-port", bridgePort - , "--network", network - ] (threadDelay 6000000) + ] (pure ()) Inherit - - --- Exercise the request functions, which just fail at the moment. -dummySpec :: SpecWith Context -dummySpec = do - it "dummy spec" $ \(Context _ (url, _)) -> do - url `shouldBe` "http://localhost:1337/" - --- Temporary test setup for testing response codes -dummySetup :: IO Context -dummySetup = do - cluster <- async (return ()) - let baseURL = T.pack ("http://httpbin.org") - manager <- newManager defaultManagerSettings - return $ Context cluster (baseURL, manager) - --- Exercise response codes -respCodesSpec :: SpecWith Context -respCodesSpec = do - it "GET; Response code 200" $ \ctx -> do - response <- request @Value ctx ("GET", "/get?my=arg") Default Empty - expectResponseCode @IO status200 response - - it "GET; Response code 404" $ \ctx -> do - response <- request @Value ctx ("GET", "/get/nothing") Default Empty - expectResponseCode @IO status404 response - - it "POST; Response code 200" $ \ctx -> do - let headers = Headers [("dummy", "header")] - let payload = Json [json| { - "addressPoolGap": 70, - "assuranceLevel": "strict", - "name": "Wallet EOS" - } |] - response <- request @Value ctx ("POST", "/post") headers payload - expectResponseCode @IO status200 response - - it "POST; Response code 200" $ \ctx -> do - let headers = Headers [("dummy", "header")] - let payloadInvalid = NonJson "{\ - \\"addressPoolGap: 70,\ - \\"assuranceLevel\": strict,\ - \\"name\": \"Wallet EOS\"\ - \}" - response <- request @Value ctx ("POST", "/post") headers payloadInvalid - expectResponseCode @IO status200 response - - it "POST; Response code 405" $ \ctx -> do - response <- request @Value ctx ("POST", "/get") None Empty - expectResponseCode @IO status405 response diff --git a/test/integration/Test/Integration/Framework/DSL.hs b/test/integration/Test/Integration/Framework/DSL.hs index 8ab252049e5..e9e224ba744 100644 --- a/test/integration/Test/Integration/Framework/DSL.hs +++ b/test/integration/Test/Integration/Framework/DSL.hs @@ -1,3 +1,9 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE KindSignatures #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE TypeApplications #-} + module Test.Integration.Framework.DSL ( Context(..) @@ -8,34 +14,80 @@ module Test.Integration.Framework.DSL -- * Expectations , expectSuccess , expectError + , expectFieldEqual + , expectFieldNotEqual , expectResponseCode , Headers(..) , Payload(..) , RequestException(..) + -- * Lens + , addressPoolGap + , balanceAvailable + , balanceTotal + , delegation + , passphraseLastUpdate + , walletId + , walletName + , state + -- * Helpers , () , (!!) + , getFromResponse , json ) where import Prelude hiding ( fail ) +import Cardano.Wallet.Api.Types + ( ApiT (..) ) +import Cardano.Wallet.Primitive.AddressDiscovery + ( AddressPoolGap, getAddressPoolGap, mkAddressPoolGap ) +import Cardano.Wallet.Primitive.Types + ( PoolId (..) + , WalletBalance (..) + , WalletDelegation (..) + , WalletId (..) + , WalletName (..) + , WalletPassphraseInfo (..) + , WalletState (..) + ) +import Control.Lens + ( set, view ) import Control.Monad.Fail ( MonadFail (..) ) import Control.Monad.IO.Class ( MonadIO ) +import Crypto.Hash + ( Blake2b_160, Digest, digestFromByteString ) import Data.Aeson.QQ ( aesonQQ ) +import Data.Generics.Internal.VL.Lens + ( Lens', lens ) +import Data.Generics.Product.Typed + ( HasType, typed ) import Data.List ( (!!) ) +import Data.Maybe + ( fromMaybe ) +import Data.Quantity + ( Quantity (..) ) import Data.Text ( Text ) +import Data.Time + ( UTCTime ) +import Data.Word + ( Word8 ) +import GHC.TypeLits + ( Symbol ) import Language.Haskell.TH.Quote ( QuasiQuoter ) +import Numeric.Natural + ( Natural ) import Test.Hspec.Expectations.Lifted - ( shouldBe ) + ( shouldBe, shouldNotBe ) import Test.Integration.Framework.Request ( Context (..) , Headers (..) @@ -47,9 +99,10 @@ import Test.Integration.Framework.Request import Web.HttpApiData ( ToHttpApiData (..) ) +import qualified Data.ByteString.Char8 as B8 +import qualified Data.Text as T import qualified Network.HTTP.Types.Status as HTTP - -- | Expect an errored response, without any further assumptions expectError :: (MonadIO m, MonadFail m, Show a) @@ -77,9 +130,128 @@ expectResponseCode expectResponseCode want (got, _) = got `shouldBe` want +expectFieldEqual + :: (MonadIO m, MonadFail m, Show a, Eq a) + => Lens' s a + -> a + -> (HTTP.Status, Either RequestException s) + -> m () +expectFieldEqual getter a (_, res) = case res of + Left e -> wantedSuccessButError e + Right s -> (view getter s) `shouldBe` a + +expectFieldNotEqual + :: (MonadIO m, MonadFail m, Show a, Eq a) + => Lens' s a + -> a + -> (HTTP.Status, Either RequestException s) + -> m () +expectFieldNotEqual getter a (_, res) = case res of + Left e -> wantedSuccessButError e + Right s -> (view getter s) `shouldNotBe` a -- --- HELPERS +-- Lenses -- +addressPoolGap :: HasType (ApiT AddressPoolGap) s => Lens' s Word8 +addressPoolGap = + lens _get _set + where + _get :: HasType (ApiT AddressPoolGap) s => s -> Word8 + _get = getAddressPoolGap . getApiT . view typed + _set :: HasType (ApiT AddressPoolGap) s => (s, Word8) -> s + _set (s, v) = set typed (ApiT $ unsafeMkAddressPoolGap v) s + +balanceAvailable :: HasType (ApiT WalletBalance) s => Lens' s Natural +balanceAvailable = + lens _get _set + where + _get :: HasType (ApiT WalletBalance) s => s -> Natural + _get = fromQuantity @"lovelace" . available . getApiT . view typed + _set :: HasType (ApiT WalletBalance) s => (s, Natural) -> s + _set (s, v) = set typed initBal s + where + initBal = + (ApiT $ WalletBalance {available = Quantity v, total = Quantity v }) + +balanceTotal :: HasType (ApiT WalletBalance) s => Lens' s Natural +balanceTotal = + lens _get _set + where + _get :: HasType (ApiT WalletBalance) s => s -> Natural + _get = fromQuantity @"lovelace" . total . getApiT . view typed + _set :: HasType (ApiT WalletBalance) s => (s, Natural) -> s + _set (s, v) = set typed initBal s + where + initBal = + (ApiT $ WalletBalance {available = Quantity v, total = Quantity v }) + +delegation + :: HasType (ApiT (WalletDelegation (ApiT PoolId))) s + => Lens' s (WalletDelegation (ApiT PoolId)) +delegation = + lens _get _set + where + _get + :: HasType (ApiT (WalletDelegation (ApiT PoolId))) s + => s + -> (WalletDelegation (ApiT PoolId)) + _get = getApiT . view typed + _set + :: HasType (ApiT (WalletDelegation (ApiT PoolId))) s + => (s, (WalletDelegation (ApiT PoolId))) + -> s + _set (s, v) = set typed (ApiT v ) s + +passphraseLastUpdate :: HasType (ApiT WalletPassphraseInfo) s => Lens' s Text +passphraseLastUpdate = + lens _get _set + where + _get :: HasType (ApiT WalletPassphraseInfo) s => s -> Text + _get = T.pack . show . lastUpdatedAt . getApiT . view typed + _set :: HasType (ApiT WalletPassphraseInfo) s => (s, Text) -> s + _set (s, v) = + set typed (ApiT $ WalletPassphraseInfo ((read $ T.unpack v) :: UTCTime)) s + +state :: HasType (ApiT WalletState) s => Lens' s WalletState +state = + lens _get _set + where + _get :: HasType (ApiT WalletState) s => s -> WalletState + _get = getApiT . view typed + _set :: HasType (ApiT WalletState) s => (s, WalletState) -> s + _set (s, v) = set typed (ApiT v ) s + +walletName :: HasType (ApiT WalletName) s => Lens' s Text +walletName = + lens _get _set + where + _get :: HasType (ApiT WalletName) s => s -> Text + _get = getWalletName . getApiT . view typed + _set :: HasType (ApiT WalletName) s => (s, Text) -> s + _set (s, v) = set typed (ApiT $ WalletName v) s + +walletId :: HasType (ApiT WalletId) s => Lens' s Text +walletId = + lens _get _set + where + _get :: HasType (ApiT WalletId) s => s -> Text + _get = T.pack . show . getWalletId . getApiT . view typed + _set :: HasType (ApiT WalletId) s => (s, Text) -> s + _set (s, v) = set typed (ApiT $ WalletId (unsafeCreateDigest v)) s +-- +-- Helpers +-- +fromQuantity :: Quantity (u :: Symbol) a -> a +fromQuantity (Quantity a) = a + +getFromResponse + :: (Show a, Eq a) + => Lens' s a + -> (HTTP.Status, Either RequestException s) + -> Maybe a +getFromResponse getter (_, res) = case res of + Left _ -> Nothing + Right s -> Just (view getter s) json :: QuasiQuoter json = aesonQQ @@ -88,6 +260,16 @@ infixr 5 () :: ToHttpApiData a => Text -> a -> Text base next = mconcat [base, "/", toQueryParam next] +unsafeCreateDigest :: Text -> Digest Blake2b_160 +unsafeCreateDigest s = fromMaybe + (error $ "unsafeCreateDigest failed to create digest from: " <> show s) + (digestFromByteString $ B8.pack $ T.unpack s) + +unsafeMkAddressPoolGap :: Word8 -> AddressPoolGap +unsafeMkAddressPoolGap g = case (mkAddressPoolGap g) of + Right a -> a + Left _ -> error $ "unsafeMkAddressPoolGap: bad argument: " <> show g + wantedSuccessButError :: (MonadFail m, Show e) => e diff --git a/test/integration/Test/Integration/Scenario/Wallets.hs b/test/integration/Test/Integration/Scenario/Wallets.hs new file mode 100644 index 00000000000..ef67cf077e2 --- /dev/null +++ b/test/integration/Test/Integration/Scenario/Wallets.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeApplications #-} + + +module Test.Integration.Scenario.Wallets + ( spec + ) where + +import Prelude + +import Cardano.Wallet.Api.Types + ( ApiWallet ) +import Cardano.Wallet.Primitive.Types + ( WalletDelegation (..), WalletState (..) ) +import Data.Quantity + ( Quantity (..) ) +import qualified Network.HTTP.Types.Status as HTTP +import Test.Hspec + ( SpecWith, it ) +import Test.Integration.Framework.DSL + ( Context (..) + , Headers (..) + , Payload (..) + , addressPoolGap + , balanceAvailable + , balanceTotal + , delegation + , expectFieldEqual + , expectFieldNotEqual + , expectResponseCode + , json + , passphraseLastUpdate + , request + , state + , walletId + , walletName + ) + +spec :: SpecWith Context +spec = do + it "Create a wallet" $ \ctx -> do + + let payload = Json [json| { + "name": "1st Wallet", + "mnemonic_sentence": ["identify", "screen", "lock", "bargain", "inch", "drop", "canyon", "flock", "dry", "zone", "wash", "argue", "system", "glory", "light"], + "mnemonic_second_factor": ["attract", "tornado", "slender", "pumpkin", "clown", "announce", "term", "winner", "ready"], + "passphrase": "Secure Passphrase", + "address_pool_gap": 20 + } |] + r <- request @ApiWallet ctx ("POST", "v2/wallets") Default payload + expectResponseCode @IO HTTP.status200 r + expectFieldEqual walletName "1st Wallet" r + expectFieldEqual addressPoolGap 20 r + expectFieldEqual balanceAvailable 0 r + expectFieldEqual balanceTotal 0 r + expectFieldEqual delegation (NotDelegating) r + expectFieldEqual state (Restoring (Quantity minBound)) r + expectFieldEqual walletId "4bba596017a63e52a4cf6caaadf8a670bfe4745b" r + expectFieldNotEqual passphraseLastUpdate "2019-04-12 07:57:28.439742724 UTC" r From 407c65cf4fe66035b6ef947c5d759c520d6c0d39 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Wed, 10 Apr 2019 08:50:37 +0200 Subject: [PATCH 2/4] Remove redundant language pragmas --- test/integration/Main.hs | 4 ---- 1 file changed, 4 deletions(-) diff --git a/test/integration/Main.hs b/test/integration/Main.hs index d3c516033e9..6d9c4eac422 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -1,7 +1,3 @@ -{-# LANGUAGE QuasiQuotes #-} -{-# LANGUAGE TypeApplications #-} - - module Main where import Prelude From 80557e1b124bb598264920d11c93185525a2a942 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Sat, 13 Apr 2019 22:58:23 +0200 Subject: [PATCH 3/4] restore small delay before running the wallet server command --- test/integration/Main.hs | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/test/integration/Main.hs b/test/integration/Main.hs index 6d9c4eac422..e7fc94cfa7c 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -28,11 +28,12 @@ main = do hspec $ do describe "Cardano.WalletSpec" Wallet.spec describe "Cardano.Wallet.Network.HttpBridge" HttpBridge.spec - beforeAll startCluster $ afterAll killCluster $ do describe "Wallets API endpoint tests" Wallets.spec - where + startUpDelay :: Int + startUpDelay = 4 * 1000 * 1000 -- 4 seconds in milliseconds + -- Run a local cluster of cardano-sl nodes, a cardano-http-bridge on top and -- a cardano wallet server connected to the bridge. startCluster :: IO Context @@ -50,7 +51,7 @@ main = do link cluster let baseURL = "http://localhost:1337/" manager <- newManager defaultManagerSettings - threadDelay 6000000 + threadDelay (2 * startUpDelay) return $ Context cluster (baseURL, manager) killCluster :: Context -> IO () @@ -76,5 +77,5 @@ main = do [ "--network", network , "--wallet-server-port", serverPort , "--http-bridge-port", bridgePort - ] (pure ()) + ] (threadDelay startUpDelay) Inherit From f768aceebaa47769bf03aae1834946c3955a15b0 Mon Sep 17 00:00:00 2001 From: Piotr Stachyra Date: Tue, 23 Apr 2019 14:56:35 +0200 Subject: [PATCH 4/4] Code review fixes: fix Post wallet, transaction and delete API declaration to comply with spec with regards to response codes --- .weeder.yaml | 2 +- cardano-wallet.cabal | 1 - src/Cardano/Wallet/Api.hs | 10 +++++----- test/integration/Test/Integration/Framework/DSL.hs | 4 +--- test/integration/Test/Integration/Scenario/Wallets.hs | 6 +++--- 5 files changed, 10 insertions(+), 13 deletions(-) diff --git a/.weeder.yaml b/.weeder.yaml index fe675047e73..31cd0d59e66 100644 --- a/.weeder.yaml +++ b/.weeder.yaml @@ -52,8 +52,8 @@ - ClientError - DecodeFailure - Empty - - None - NonJson + - None - unsafeRequest - section: - name: test:unit diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index 45a64014f02..f4623381913 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -206,7 +206,6 @@ test-suite integration , http-client , http-api-data , http-types - , lens , process , say , template-haskell diff --git a/src/Cardano/Wallet/Api.hs b/src/Cardano/Wallet/Api.hs index c2a412baf4e..03be253f966 100644 --- a/src/Cardano/Wallet/Api.hs +++ b/src/Cardano/Wallet/Api.hs @@ -19,12 +19,12 @@ import Servant.API ( (:<|>) , (:>) , Capture - , Delete + , DeleteNoContent , Get , JSON , NoContent , OctetStream - , Post + , PostAccepted , Put , QueryParam , ReqBody @@ -64,7 +64,7 @@ type Wallets = -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/deleteWallet type DeleteWallet = "wallets" :> Capture "walletId" (ApiT WalletId) - :> Delete '[OctetStream] NoContent + :> DeleteNoContent '[OctetStream] NoContent -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/getWallet type GetWallet = "wallets" @@ -78,7 +78,7 @@ type ListWallets = "wallets" -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/postWallet type PostWallet = "wallets" :> ReqBody '[JSON] WalletPostData - :> Post '[JSON] ApiWallet + :> PostAccepted '[JSON] ApiWallet -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/putWallet type PutWallet = "wallets" @@ -107,4 +107,4 @@ type CreateTransaction = "wallets" :> Capture "walletId" (ApiT WalletId) :> "transactions" :> ReqBody '[JSON] PostTransactionData - :> Post '[JSON] ApiTransaction + :> PostAccepted '[JSON] ApiTransaction diff --git a/test/integration/Test/Integration/Framework/DSL.hs b/test/integration/Test/Integration/Framework/DSL.hs index e9e224ba744..f65478c70b7 100644 --- a/test/integration/Test/Integration/Framework/DSL.hs +++ b/test/integration/Test/Integration/Framework/DSL.hs @@ -54,8 +54,6 @@ import Cardano.Wallet.Primitive.Types , WalletPassphraseInfo (..) , WalletState (..) ) -import Control.Lens - ( set, view ) import Control.Monad.Fail ( MonadFail (..) ) import Control.Monad.IO.Class @@ -65,7 +63,7 @@ import Crypto.Hash import Data.Aeson.QQ ( aesonQQ ) import Data.Generics.Internal.VL.Lens - ( Lens', lens ) + ( Lens', lens, set, view ) import Data.Generics.Product.Typed ( HasType, typed ) import Data.List diff --git a/test/integration/Test/Integration/Scenario/Wallets.hs b/test/integration/Test/Integration/Scenario/Wallets.hs index ef67cf077e2..e2785739bb9 100644 --- a/test/integration/Test/Integration/Scenario/Wallets.hs +++ b/test/integration/Test/Integration/Scenario/Wallets.hs @@ -46,12 +46,12 @@ spec = do "mnemonic_sentence": ["identify", "screen", "lock", "bargain", "inch", "drop", "canyon", "flock", "dry", "zone", "wash", "argue", "system", "glory", "light"], "mnemonic_second_factor": ["attract", "tornado", "slender", "pumpkin", "clown", "announce", "term", "winner", "ready"], "passphrase": "Secure Passphrase", - "address_pool_gap": 20 + "address_pool_gap": 30 } |] r <- request @ApiWallet ctx ("POST", "v2/wallets") Default payload - expectResponseCode @IO HTTP.status200 r + expectResponseCode @IO HTTP.status202 r expectFieldEqual walletName "1st Wallet" r - expectFieldEqual addressPoolGap 20 r + expectFieldEqual addressPoolGap 30 r expectFieldEqual balanceAvailable 0 r expectFieldEqual balanceTotal 0 r expectFieldEqual delegation (NotDelegating) r