From 08560dcff7e2402e390782d1a00f195bb90bb907 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 22 Mar 2019 17:15:37 +0100 Subject: [PATCH 1/2] remove unused 'printInfo' function from the wallet layer impl. --- cardano-wallet.cabal | 1 - src/Cardano/Wallet.hs | 24 ++---------------------- 2 files changed, 2 insertions(+), 23 deletions(-) diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index fcdf77a80c9..f2d89cfe8c2 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -50,7 +50,6 @@ library , http-client , http-media , memory - , say , servant , servant-client , servant-client-core diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs index a4f16374729..f3207014b8b 100644 --- a/src/Cardano/Wallet.hs +++ b/src/Cardano/Wallet.hs @@ -32,14 +32,7 @@ import Cardano.Wallet.Primitive.AddressDiscovery import Cardano.Wallet.Primitive.Mnemonic ( Mnemonic, entropyToBytes, mnemonicToEntropy ) import Cardano.Wallet.Primitive.Model - ( Wallet - , WalletId (..) - , WalletName (..) - , applyBlock - , availableBalance - , currentTip - , initWallet - ) + ( Wallet, WalletId (..), WalletName (..), applyBlock, initWallet ) import Cardano.Wallet.Primitive.Types ( Block (..) ) import Control.DeepSeq @@ -52,12 +45,8 @@ import Data.List ( foldl' ) import Data.List.NonEmpty ( NonEmpty ((:|)) ) -import Fmt - ( build, (+|), (|+) ) import GHC.Generics ( Generic ) -import Say - ( say ) import qualified Data.Set as Set @@ -126,8 +115,7 @@ mkWalletLayer db network = WalletLayer Just (w :| _) -> return w - , watchWallet = \wid -> - listen network $ \blocks -> applyBlocks wid blocks *> printInfo wid + , watchWallet = listen network . applyBlocks } where applyBlocks :: WalletId -> [Block] -> IO () @@ -140,11 +128,3 @@ mkWalletLayer db network = WalletLayer let cps' = foldl' (flip applyBlock) cps (filter nonEmpty blocks) return cps' cps' `deepseq` putCheckpoints db (PrimaryKey wid) cps' - - printInfo :: WalletId -> IO () - printInfo wid = readCheckpoints db (PrimaryKey wid) >>= \case - Nothing -> - say "No available checkpoints" - Just (cp :| _) -> do - say $ "Current tip: " +| build (currentTip cp) - say $ "Available balance: " +| (availableBalance cp) |+ " Lovelaces" From 981fecdc3d73d5b2d0c8438921267dc9d491ae7a Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 22 Mar 2019 19:27:47 +0100 Subject: [PATCH 2/2] add integration tests to sync a wallet (via 'watchWallet') --- cardano-wallet.cabal | 1 + .../Cardano/Wallet/Network/HttpBridgeSpec.hs | 5 +- test/integration/Cardano/WalletSpec.hs | 80 +++++++++++++++++++ test/integration/Main.hs | 2 + 4 files changed, 87 insertions(+), 1 deletion(-) create mode 100644 test/integration/Cardano/WalletSpec.hs diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index f2d89cfe8c2..af6b552d091 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -203,6 +203,7 @@ test-suite integration main-is: Main.hs other-modules: + Cardano.WalletSpec Cardano.Wallet.Network.HttpBridgeSpec Cardano.Launcher Test.Integration.Framework.DSL diff --git a/test/integration/Cardano/Wallet/Network/HttpBridgeSpec.hs b/test/integration/Cardano/Wallet/Network/HttpBridgeSpec.hs index 7ee8284a107..7753f26c9e1 100644 --- a/test/integration/Cardano/Wallet/Network/HttpBridgeSpec.hs +++ b/test/integration/Cardano/Wallet/Network/HttpBridgeSpec.hs @@ -43,7 +43,7 @@ port = 1337 spec :: Spec spec = do - describe "Happy paths" $ beforeAll startBridge $ afterAll (cancel . fst) $ do + describe "Happy paths" $ beforeAll startBridge $ afterAll closeBridge $ do it "get from packed epochs" $ \(_, network) -> do let blocks = runExceptT $ nextBlocks network (SlotId 14 0) (fmap length <$> blocks) @@ -88,6 +88,9 @@ spec = do where newNetworkLayer = HttpBridge.newNetworkLayer "testnet" port + closeBridge (handle, _) = do + cancel handle + threadDelay 500000 startBridge = do handle <- async $ launch [ Command "cardano-http-bridge" diff --git a/test/integration/Cardano/WalletSpec.hs b/test/integration/Cardano/WalletSpec.hs new file mode 100644 index 00000000000..c0da5239295 --- /dev/null +++ b/test/integration/Cardano/WalletSpec.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} + +module Cardano.WalletSpec + ( spec + ) where + +import Prelude + +import Cardano.Launcher + ( Command (..), launch ) +import Cardano.Wallet + ( NewWallet (..), WalletLayer (..), mkWalletLayer ) +import Cardano.Wallet.Primitive.Mnemonic + ( EntropySize, entropyToMnemonic, genEntropy ) +import Cardano.Wallet.Primitive.Model + ( WalletName (..), currentTip ) +import Cardano.Wallet.Primitive.Types + ( SlotId (..) ) +import Control.Concurrent + ( threadDelay ) +import Control.Concurrent.Async + ( async, cancel ) +import Control.Monad + ( (>=>) ) +import Control.Monad.Fail + ( MonadFail ) +import Control.Monad.Trans.Except + ( ExceptT, runExceptT ) +import Test.Hspec + ( Spec, after, before, it, shouldSatisfy ) + +import qualified Cardano.Wallet.DB.MVar as MVar +import qualified Cardano.Wallet.Network.HttpBridge as HttpBridge + +spec :: Spec +spec = do + before startBridge $ after closeBridge $ do + it "A newly created wallet can sync with the chain" $ \(_, wallet) -> do + mnemonicSentence <- + entropyToMnemonic <$> genEntropy @(EntropySize 15) + wid <- unsafeRunExceptT $ createWallet wallet NewWallet + { mnemonic = mnemonicSentence + , mnemonic2ndFactor = mempty + , name = WalletName "My Wallet" + , passphrase = mempty + , gap = minBound + } + handle <- async (watchWallet wallet wid) + threadDelay 5000000 + cancel handle + tip <- currentTip <$> unsafeRunExceptT (getWallet wallet wid) + tip `shouldSatisfy` (> SlotId 0 0) + where + port = 1337 + closeBridge (handle, _) = do + cancel handle + threadDelay 500000 + startBridge = do + handle <- async $ launch + [ Command "cardano-http-bridge" + [ "start" + , "--port", show port + , "--template", "testnet" + ] + (return ()) + ] + threadDelay 1000000 + (handle,) <$> (mkWalletLayer + <$> MVar.newDBLayer + <*> HttpBridge.newNetworkLayer "testnet" port) + +unsafeRunExceptT :: (MonadFail m, Show e) => ExceptT e m a -> m a +unsafeRunExceptT = runExceptT >=> \case + Left e -> + fail $ "unable to perform expect IO action: " <> show e + Right a -> + return a diff --git a/test/integration/Main.hs b/test/integration/Main.hs index b790c458992..98572236fca 100644 --- a/test/integration/Main.hs +++ b/test/integration/Main.hs @@ -34,11 +34,13 @@ import Test.Integration.Framework.DSL ) import qualified Cardano.Wallet.Network.HttpBridgeSpec as HttpBridge +import qualified Cardano.WalletSpec as Wallet import qualified Data.Text as T main :: IO () main = do hspec $ do + describe "Cardano.WalletSpec" Wallet.spec describe "Cardano.Wallet.Network.HttpBridge" HttpBridge.spec beforeAll (withWallet (newMVar . Context ())) $ do