refactor temporary transaction scenario & provide a 'fixtureWallet' u…

…tility to generate wallet with funds

lib/http-bridge/test/data/cardano-node-simple/configuration.yaml

@@ -23,7 +23,7 @@ default: &default
           slotDuration:      10000
           maxBlockSize:      2000000
           maxHeaderSize:     2000000
-          maxTxSize:         4096 # 4 Kb
+          maxTxSize:         65536 # 64 Kb
           maxProposalSize:   700 # 700 bytes
           mpcThd:            0.01 # 1% of stake
           heavyDelThd:       0.005 # 0.5% of stake

lib/http-bridge/test/integration/Main.hs

@@ -40,6 +40,8 @@ import System.IO
     ( IOMode (..), hClose, openFile )
 import Test.Hspec
     ( after, afterAll, beforeAll, describe, hspec )
+import Test.Integration.Faucet
+    ( initFaucet )
 import Test.Integration.Framework.DSL
     ( Context (..), tearDown )
 
@@ -93,6 +95,7 @@ main = do
     startCluster = do
         let stateDir = "./test/data/cardano-node-simple"
         let networkDir = "/tmp/cardano-http-bridge/networks"
+        let bridgePort = 8080
         removePathForcibly (networkDir <> "/local")
         handle <-
             openFile "/tmp/cardano-wallet-launcher" WriteMode
@@ -103,19 +106,21 @@ main = do
             , cardanoNodeSimple stateDir systemStart ("core1", "127.0.0.1:3001")
             , cardanoNodeSimple stateDir systemStart ("core2", "127.0.0.1:3002")
             , cardanoNodeSimple stateDir systemStart ("relay", "127.0.0.1:3100")
-            , cardanoHttpBridge "8080" "local" networkDir handle
+            , cardanoHttpBridge bridgePort"local" networkDir handle
             ]
         link cluster
-        let baseURL = "http://localhost:1337/"
-        manager <- newManager defaultManagerSettings
         wait ("cluster", clusterWarmUpDelay)
         wait ("cardano-http-bridge", bridgeWarmUpDelay)
-        cardanoWalletServer 1337 8080
+        nl <- HttpBridge.newNetworkLayer bridgePort
+        cardanoWalletServer nl 1337
         wait ("cardano-wallet", walletWarmUpDelay)
-        return $ Context cluster (baseURL, manager) handle
+        let baseURL = "http://localhost:1337/"
+        manager <- newManager defaultManagerSettings
+        faucet <- putStrLn "Creating money out of thin air..." *> initFaucet nl
+        return $ Context cluster (baseURL, manager) handle faucet
 
     killCluster :: Context -> IO ()
-    killCluster (Context cluster _ handle) = do
+    killCluster (Context cluster _ handle _) = do
         cancel cluster
         hClose handle
 
@@ -138,17 +143,16 @@ main = do
         "cardano-http-bridge"
         [ "start"
         , "--template", template
-        , "--port", port
+        , "--port", show port
         , "--networks-dir", dir
         ] (threadDelay clusterWarmUpDelay)
         (UseHandle handle)
 
     -- NOTE
     -- We start the wallet server in the same process such that we get
     -- code coverage measures from running the scenarios on top of it!
-    cardanoWalletServer serverPort bridgePort = void $ forkIO $ do
+    cardanoWalletServer nl serverPort = void $ forkIO $ do
         db <- MVar.newDBLayer
-        nl <- HttpBridge.newNetworkLayer bridgePort
         let tl = HttpBridge.newTransactionLayer
         let wallet = mkWalletLayer @_ @HttpBridge db nl tl
         let settings = Warp.defaultSettings & Warp.setPort serverPort

lib/http-bridge/test/integration/Test/Integration/Faucet.hs

@@ -1,33 +1,63 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 
 module Test.Integration.Faucet
-    ( mkRedeemTx
+    ( Faucet
+    , initFaucet
+    , nextWallet
     ) where
 
 import Prelude
 
 import Cardano.Environment.HttpBridge
     ( ProtocolMagic (..), network, protocolMagic )
+import Cardano.Wallet
+    ( unsafeRunExceptT )
 import Cardano.Wallet.Binary.HttpBridge
     ( toByteString )
 import Cardano.Wallet.Compatibility.HttpBridge
     ( HttpBridge )
+import Cardano.Wallet.Network
+    ( NetworkLayer (postTx) )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( Passphrase (..), XPrv )
+    ( ChangeChain (..)
+    , KeyToAddress (..)
+    , Passphrase (..)
+    , XPrv
+    , deriveAccountPrivateKey
+    , deriveAddressPrivateKey
+    , generateKeyFromSeed
+    , publicKey
+    )
+import Cardano.Wallet.Primitive.Mnemonic
+    ( Mnemonic
+    , entropyToBytes
+    , entropyToMnemonic
+    , genEntropy
+    , mnemonicToEntropy
+    )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
+    , Coin (..)
     , Hash (..)
     , Tx (..)
     , TxId (..)
     , TxIn (..)
     , TxOut (..)
     , TxWitness (..)
     )
+import Control.Concurrent.MVar
+    ( MVar, newMVar, putMVar, takeMVar )
+import Control.Monad
+    ( replicateM )
 import Data.ByteArray.Encoding
     ( Base (..), convertFromBase )
 import Data.ByteString
     ( ByteString )
+import Data.Functor
+    ( (<$) )
 import Data.Text
     ( Text )
 import Data.Text.Class
@@ -38,6 +68,46 @@ import Data.Word
 import qualified Cardano.Crypto.Wallet as CC
 import qualified Codec.CBOR.Encoding as CBOR
 
+-- | An opaque 'Faucet' type from which one can get a wallet with funds
+newtype Faucet = Faucet (MVar [Mnemonic 15])
+
+-- | Get the next faucet wallet. Requires the 'initFaucet' to be called in order
+-- to get a hand on a 'Faucet'.
+nextWallet :: Faucet -> IO (Mnemonic 15)
+nextWallet (Faucet mvar) = do
+    takeMVar mvar >>= \case
+        [] -> fail "nextWallet: Awe crap! No more faucet wallet available!"
+        (h:q) -> h <$ putMVar mvar q
+
+-- | Initialize a bunch of faucet wallets and make them available for the
+-- integration tests scenarios.
+initFaucet :: NetworkLayer IO -> IO Faucet
+initFaucet nl = do
+    wallets <- replicateM 100 genMnemonic
+    let outs = uncurry TxOut . (,Coin 1000000000000) . firstAddress <$> wallets
+    unsafeRunExceptT $ postTx nl (mkRedeemTx outs)
+    Faucet <$> newMVar wallets
+  where
+    genMnemonic :: IO (Mnemonic 15)
+    genMnemonic = entropyToMnemonic <$> genEntropy
+    firstAddress :: Mnemonic 15 -> Address
+    firstAddress mw =
+        let
+            (seed, pwd) =
+                (Passphrase $ entropyToBytes $ mnemonicToEntropy mw, mempty)
+            rootXPrv =
+                generateKeyFromSeed (seed, mempty) pwd
+            accXPrv =
+                deriveAccountPrivateKey pwd rootXPrv minBound
+            addrXPrv =
+                deriveAddressPrivateKey pwd accXPrv ExternalChain minBound
+        in
+            keyToAddress @HttpBridge (publicKey addrXPrv)
+
+{-------------------------------------------------------------------------------
+                                    Internal
+-------------------------------------------------------------------------------}
+
 -- | Redeem funds from an address, to the given outputs. The corresponding
 -- private keys are known by the redeem function and will be looked up
 -- for the given address.
@@ -46,16 +116,16 @@ import qualified Codec.CBOR.Encoding as CBOR
 -- with the 'TransactionLayer' although the list contains a single element.
 --
 -- NOTE (2): This is a one-time call only. There's no change output generated.
--- However, we can put here as many outputs as we want / can (8kb transaction
--- means that we can add up to ~145 outputs before needing two transactions...).
+-- However, we can put here as many outputs as we want / can (64kb transaction
+-- means that we can add up to ~1K outputs before needing two transactions...).
 --
--- NOTE (3): There is a total of `4 500 000 000 ADA` available in the faucet.
+-- NOTE (3): There is a total of `4 500 000 000 ADA` available in the genesis.
 mkRedeemTx
     :: [TxOut]
     -> (Tx, [TxWitness])
 mkRedeemTx outs =
     let
-        (txin, _, xprv, pwd) = faucet
+        (txin, _, xprv, pwd) = genesis
         tx = Tx [txin] outs
         witness = mkWitness (txId @HttpBridge tx) (xprv, pwd)
     in
@@ -75,21 +145,21 @@ mkRedeemTx outs =
             <> toByteString (CBOR.encodeInt32 pm)
             <> toByteString (CBOR.encodeBytes tx)
 
--- | A faucet / genesis UTxO generate from the configuration.yaml.
+-- | A genesis UTxO generated from the configuration.yaml.
 -- The secret key can be generated using `cardano-keygen`, and then, using
--- `deriveForstHDAddress` from cardano-sl to get the corresponding address key.
+-- `deriveFirstHDAddress` from cardano-sl to get the corresponding address key.
 --
 -- A peek in the node's database / UTxO will also yield the initial "fake"
--- transaction id and input index to use as a an entry. Funds available to the
+-- transaction id and input index to use as an entry. Funds available to the
 -- address depends on:
 --
 -- - `genesis.spec.initializer.testBalance.totalBalance`
 -- - `genesis.spec.initializer.testBalance.poors`
 -- - `genesis.spec.initializer.testBalance.richmenShare`
 --
 -- If funds were to miss for the integration tests, increase the `totalBalance`.
-faucet :: (TxIn, Address, XPrv, Passphrase "encryption")
-faucet =
+genesis :: (TxIn, Address, XPrv, Passphrase "encryption")
+genesis =
     ( unsafeTxIn 0
         "ad348750ba0673f5829ac2c73e1ddf59ae4219222ee5703b05a5af5457981c17"
     , unsafeAddress

lib/http-bridge/test/integration/Test/Integration/Framework/DSL.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE TypeApplications #-}
 
@@ -41,6 +42,7 @@ module Test.Integration.Framework.DSL
     , getFromResponse
     , json
     , tearDown
+    , fixtureWallet
     ) where
 
 import Prelude hiding
@@ -50,6 +52,8 @@ import Cardano.Wallet.Api.Types
     ( ApiT (..), ApiWallet )
 import Cardano.Wallet.Primitive.AddressDiscovery
     ( AddressPoolGap, getAddressPoolGap, mkAddressPoolGap )
+import Cardano.Wallet.Primitive.Mnemonic
+    ( mnemonicToText )
 import Cardano.Wallet.Primitive.Types
     ( PoolId (..)
     , WalletBalance (..)
@@ -60,7 +64,9 @@ import Cardano.Wallet.Primitive.Types
     , WalletState (..)
     )
 import Control.Monad
-    ( forM_ )
+    ( forM_, unless )
+import Control.Monad.Catch
+    ( MonadCatch )
 import Control.Monad.Fail
     ( MonadFail (..) )
 import Control.Monad.IO.Class
@@ -95,6 +101,8 @@ import Numeric.Natural
     ( Natural )
 import Test.Hspec.Expectations.Lifted
     ( shouldBe, shouldContain, shouldNotBe )
+import Test.Integration.Faucet
+    ( nextWallet )
 import Test.Integration.Framework.Request
     ( Context (..)
     , Headers (..)
@@ -201,6 +209,27 @@ expectListSizeEqual l (_, res) = case res of
     Left e   -> wantedSuccessButError e
     Right xs -> length (toList xs) `shouldBe` l
 
+-- | Expects wallet from the request to eventually reach the given state or
+-- beyond
+expectEventually
+    :: (MonadIO m, MonadCatch m, MonadFail m, Show a, Ord a)
+    => Context
+    -> Lens' ApiWallet a
+    -> a
+    -> (HTTP.Status, Either RequestException ApiWallet)
+    -> m ()
+expectEventually ctx getter target (_, res) = case res of
+    Left e -> wantedSuccessButError e
+    Right s -> loopUntilRestore (s ^. walletId)
+
+  where
+    loopUntilRestore :: (MonadIO m, MonadCatch m) => Text -> m ()
+    loopUntilRestore wid = do
+        r <- request @ApiWallet ctx ("GET", "v2/wallets/" <> wid) Default Empty
+        let target' = getFromResponse getter r
+        unless (target' >= target) $ loopUntilRestore wid
+
+
 -- | Apply 'a' to all actions in sequence
 verify :: (Monad m) => a -> [a -> m ()] -> m ()
 verify a = mapM_ (a &)
@@ -295,10 +324,28 @@ walletId =
     _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
 --
 
+-- | Restore a faucet and wait until funds are available.
+fixtureWallet
+    :: Context
+    -> IO ApiWallet
+fixtureWallet ctx@(Context _ _ _ faucet) = do
+    mnemonics <- mnemonicToText <$> nextWallet faucet
+    let payload = Json [aesonQQ| {
+            "name": "Faucet Wallet",
+            "mnemonic_sentence": #{mnemonics},
+            "passphrase": "cardano-wallet"
+            } |]
+    r <- request @ApiWallet ctx ("POST", "v2/wallets") Default payload
+    expectEventually ctx state Ready r
+    let wid = getFromResponse walletId r
+    r' <- request @ApiWallet ctx ("GET", "v2/wallets/" <> wid) Default Empty
+    return $ getFromResponse id r'
+
 fromQuantity :: Quantity (u :: Symbol) a -> a
 fromQuantity (Quantity a) = a
 

lib/http-bridge/test/integration/Test/Integration/Framework/Request.hs

@@ -47,6 +47,8 @@ import Network.HTTP.Types.Status
     ( status500 )
 import System.IO
     ( Handle )
+import Test.Integration.Faucet
+    ( Faucet )
 
 import qualified Data.Aeson as Aeson
 import qualified Data.Text as T
@@ -65,6 +67,11 @@ data Context = Context
     , _logs
         :: Handle
         -- ^ A file 'Handle' to the launcher log output
+
+    , _faucet
+        :: Faucet
+        -- ^ A 'Faucet' handle in to have access to funded wallets in
+        -- integration tests.
     }
 
 -- | The result when 'request' fails.
@@ -105,7 +112,7 @@ request
     -> Payload
         -- ^ Request body
     -> m (HTTP.Status, Either RequestException a)
-request (Context _ (base, manager) _) (verb, path) reqHeaders body = do
+request (Context _ (base, manager) _ _) (verb, path) reqHeaders body = do
     req <- parseRequest $ T.unpack $ base <> path
     handleResponse <$> liftIO (httpLbs (prepareReq req) manager)
   where