Technical Debt: Wallet Layer & Network 'listen' testing

cardano-wallet.cabal

@@ -50,7 +50,6 @@ library
     , http-client
     , http-media
     , memory
-    , say
     , servant
     , servant-client
     , servant-client-core
@@ -204,6 +203,7 @@ test-suite integration
   main-is:
       Main.hs
   other-modules:
+      Cardano.WalletSpec
       Cardano.Wallet.Network.HttpBridgeSpec
       Cardano.Launcher
       Test.Integration.Framework.DSL

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"

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"

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

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