From c71257d45c85c050187e518a77aae3c7ab7b3e26 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 26 Apr 2019 15:51:19 +0200 Subject: [PATCH 1/4] make the wallet layer state-agnostic (instead of requiring a 'SeqState') --- src/Cardano/Wallet.hs | 89 +++++------- src/Cardano/Wallet/Api/Server.hs | 30 ++-- src/Cardano/Wallet/DB.hs | 10 +- src/Cardano/Wallet/DB/MVar.hs | 24 +++- .../Wallet/Primitive/AddressDiscovery.hs | 21 ++- test/bench/Main.hs | 55 +++++--- test/integration/Cardano/WalletSpec.hs | 20 +-- test/unit/Cardano/Wallet/DB/MVarSpec.hs | 40 +++--- test/unit/Cardano/WalletSpec.hs | 131 ++++++------------ 9 files changed, 201 insertions(+), 219 deletions(-) diff --git a/src/Cardano/Wallet.hs b/src/Cardano/Wallet.hs index 1616da4cc4b..bbdab59d380 100644 --- a/src/Cardano/Wallet.hs +++ b/src/Cardano/Wallet.hs @@ -1,11 +1,11 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedLabels #-} {-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | -- Copyright: © 2018-2019 IOHK @@ -20,7 +20,6 @@ module Cardano.Wallet ( -- * Interface WalletLayer (..) - , NewWallet(..) -- * Errors , ErrNoSuchWallet(..) @@ -61,19 +60,10 @@ import Cardano.Wallet.Primitive.AddressDerivation , Passphrase , XPrv , checkPassphrase - , deriveAccountPrivateKey - , digest , encryptPassphrase - , generateKeyFromSeed - , publicKey ) import Cardano.Wallet.Primitive.AddressDiscovery - ( AddressPoolGap - , SeqState (..) - , emptyPendingIxs - , mkAddressPool - , nextChangeAddress - ) + ( AddressScheme (..) ) import Cardano.Wallet.Primitive.Model ( Wallet , applyBlocks @@ -90,6 +80,7 @@ import Cardano.Wallet.Primitive.Types ( Block (..) , Coin (..) , Direction (..) + , IsOurs (..) , SignedTx (..) , SlotId (..) , Tx @@ -109,6 +100,8 @@ import Control.Arrow ( first ) import Control.Concurrent ( forkIO, threadDelay ) +import Control.DeepSeq + ( NFData ) import Control.Monad ( forM, void, (>=>) ) import Control.Monad.Fail @@ -135,8 +128,6 @@ import Data.Time.Clock ( getCurrentTime ) import Fmt ( (+|), (+||), (|+), (||+) ) -import GHC.Generics - ( Generic ) import qualified Cardano.Wallet.CoinSelection.Policy.Random as CoinSelection import qualified Cardano.Wallet.DB as DB @@ -149,9 +140,11 @@ import qualified Data.Text.IO as TIO data WalletLayer s = WalletLayer { createWallet - :: NewWallet + :: WalletId + -> WalletName + -> s -> ExceptT ErrWalletAlreadyExists IO WalletId - -- ^ Initialise and store a new wallet, returning its ID. + -- ^ Initialise and store a new wallet, returning its Id. , readWallet :: WalletId @@ -205,20 +198,15 @@ data WalletLayer s = WalletLayer -> (Tx, TxMeta, [TxWitness]) -> ExceptT ErrSubmitTx IO () -- ^ Broadcast a (signed) transaction to the network. - } -data NewWallet = NewWallet - { seed - :: !(Passphrase "seed") - , secondFactor - :: !(Passphrase "generation") - , name - :: !WalletName - , passphrase - :: !(Passphrase "encryption") - , gap - :: !AddressPoolGap - } deriving (Show, Generic) + , attachPrivateKey + :: WalletId + -> (Key 'RootK XPrv, Passphrase "encryption") + -> ExceptT ErrNoSuchWallet IO () + -- ^ Attach a given private key to a wallet. The private key is + -- necessary for some operations like signing transactions or, + -- generating new accounts. + } -- | Errors occuring when creating an unsigned transaction data ErrCreateUnsignedTx @@ -242,41 +230,26 @@ data ErrSubmitTx -- | Create a new instance of the wallet layer. mkWalletLayer - :: DBLayer IO SeqState + :: forall s. (IsOurs s, AddressScheme s, NFData s, Show s) + => DBLayer IO s -> NetworkLayer IO - -> WalletLayer SeqState + -> WalletLayer s mkWalletLayer db network = WalletLayer {--------------------------------------------------------------------------- Wallets ---------------------------------------------------------------------------} - { createWallet = \w -> do - let rootXPrv = - generateKeyFromSeed (seed w, secondFactor w) (passphrase w) - let accXPrv = - deriveAccountPrivateKey mempty rootXPrv minBound - let extPool = - mkAddressPool (publicKey accXPrv) (gap w) [] - let intPool = - mkAddressPool (publicKey accXPrv) minBound [] - let wid = - WalletId (digest $ publicKey rootXPrv) - let checkpoint = initWallet $ SeqState - { externalPool = extPool - , internalPool = intPool - , pendingChangeIxs = emptyPendingIxs - } + { createWallet = \wid wname s -> do + let checkpoint = initWallet s now <- liftIO getCurrentTime let metadata = WalletMetadata - { name = Cardano.Wallet.name w + { name = wname , passphraseInfo = WalletPassphraseInfo now , status = Restoring minBound , delegation = NotDelegating } - hpwd <- liftIO $ encryptPassphrase (passphrase w) - let creds = ( rootXPrv, hpwd ) - DB.createWallet db (PrimaryKey wid) checkpoint metadata creds $> wid + DB.createWallet db (PrimaryKey wid) checkpoint metadata $> wid , readWallet = _readWallet @@ -314,8 +287,8 @@ mkWalletLayer db network = WalletLayer withRootKey wid pwd ErrSignTxWrongPassphrase $ \xprv -> do case mkStdTx (getState w) (xprv, pwd) ins allShuffledOuts of Right (tx, wit) -> do - -- Safe because we have a lock and we already fetched the wallet - -- within this context. + -- Safe because we have a lock and we already fetched the + -- wallet within this context. liftIO . unsafeRunExceptT $ DB.putCheckpoint db (PrimaryKey wid) (updateState s' w) let amtChng = fromIntegral $ @@ -340,11 +313,19 @@ mkWalletLayer db network = WalletLayer let history = Map.fromList [(txId tx, (tx, meta))] DB.putCheckpoint db (PrimaryKey wid) (newPending tx w) DB.putTxHistory db (PrimaryKey wid) history + + {--------------------------------------------------------------------------- + Keystore + ---------------------------------------------------------------------------} + + , attachPrivateKey = \wid (xprv, pwd) -> do + hpwd <- liftIO $ encryptPassphrase pwd + DB.putPrivateKey db (PrimaryKey wid) (xprv, hpwd) } where _readWallet :: WalletId - -> ExceptT ErrNoSuchWallet IO (Wallet SeqState, WalletMetadata) + -> ExceptT ErrNoSuchWallet IO (Wallet s, WalletMetadata) _readWallet wid = maybeToExceptT (ErrNoSuchWallet wid) $ do cp <- MaybeT $ DB.readCheckpoint db (PrimaryKey wid) meta <- MaybeT $ DB.readWalletMeta db (PrimaryKey wid) diff --git a/src/Cardano/Wallet/Api/Server.hs b/src/Cardano/Wallet/Api/Server.hs index 78d89a72411..bb7ac36ced1 100644 --- a/src/Cardano/Wallet/Api/Server.hs +++ b/src/Cardano/Wallet/Api/Server.hs @@ -21,7 +21,6 @@ import Cardano.Wallet , ErrSignTx (..) , ErrSubmitTx (..) , ErrWalletAlreadyExists (..) - , NewWallet (..) , WalletLayer ) import Cardano.Wallet.Api @@ -43,12 +42,14 @@ import Cardano.Wallet.Binary ( txId ) import Cardano.Wallet.CoinSelection ( CoinSelectionOptions (..) ) +import Cardano.Wallet.Primitive.AddressDerivation + ( digest, generateKeyFromSeed, publicKey ) import Cardano.Wallet.Primitive.AddressDiscovery - ( SeqState (..), defaultAddressPoolGap ) + ( SeqState (..), defaultAddressPoolGap, mkSeqState ) import Cardano.Wallet.Primitive.Model ( availableBalance, getState, totalBalance ) import Cardano.Wallet.Primitive.Types - ( AddressState, Coin (..), TxOut (..), WalletId ) + ( AddressState, Coin (..), TxOut (..), WalletId (..) ) import Control.Monad.Catch ( throwM ) import Control.Monad.IO.Class @@ -143,19 +144,16 @@ postWallet :: WalletLayer SeqState -> WalletPostData -> Handler ApiWallet -postWallet w req = do - wid <- liftHandler $ W.createWallet w $ NewWallet - { seed = - getApiMnemonicT (req ^. #mnemonicSentence) - , secondFactor = - maybe mempty getApiMnemonicT (req ^. #mnemonicSecondFactor) - , name = - getApiT (req ^. #name) - , passphrase = - getApiT (req ^. #passphrase) - , gap = - maybe defaultAddressPoolGap getApiT (req ^. #addressPoolGap) - } +postWallet w body = do + let seed = getApiMnemonicT (body ^. #mnemonicSentence) + let secondFactor = maybe mempty getApiMnemonicT (body ^. #mnemonicSecondFactor) + let pwd = getApiT (body ^. #passphrase) + let rootXPrv = generateKeyFromSeed (seed, secondFactor) pwd + let g = maybe defaultAddressPoolGap getApiT (body ^. #addressPoolGap) + let s = mkSeqState (rootXPrv, pwd) g + let wid = WalletId $ digest $ publicKey rootXPrv + _ <- liftHandler $ W.createWallet w wid (getApiT (body ^. #name)) s + liftHandler $ W.attachPrivateKey w wid (rootXPrv, pwd) liftHandler $ W.restoreWallet w wid getWallet w (ApiT wid) diff --git a/src/Cardano/Wallet/DB.hs b/src/Cardano/Wallet/DB.hs index ffddf72363e..b0337e5c46f 100644 --- a/src/Cardano/Wallet/DB.hs +++ b/src/Cardano/Wallet/DB.hs @@ -40,7 +40,6 @@ data DBLayer m s = DBLayer :: PrimaryKey WalletId -> Wallet s -> WalletMetadata - -> (Key 'RootK XPrv, Hash "encryption") -> ExceptT ErrWalletAlreadyExists m () -- ^ Initialize a database entry for a given wallet. 'putCheckpoint', -- 'putWalletMeta' or 'putTxHistory' will actually all fail if they are @@ -106,6 +105,15 @@ data DBLayer m s = DBLayer -- -- Returns an empty map if the wallet isn't found. + , putPrivateKey + :: PrimaryKey WalletId + -> (Key 'RootK XPrv, Hash "encryption") + -> ExceptT ErrNoSuchWallet m () + -- ^ Store or replace a private key for a given wallet. Note that wallet + -- _could_ be stored and manipulated without any private key associated + -- to it. A private key is only seldomly required for very specific + -- operations (like transaction signing). + , readPrivateKey :: PrimaryKey WalletId -> m (Maybe (Key 'RootK XPrv, Hash "encryption")) diff --git a/src/Cardano/Wallet/DB/MVar.hs b/src/Cardano/Wallet/DB/MVar.hs index 91bb1675b4e..b13f5e90cd8 100644 --- a/src/Cardano/Wallet/DB/MVar.hs +++ b/src/Cardano/Wallet/DB/MVar.hs @@ -32,6 +32,8 @@ import Control.Concurrent.MVar ( MVar, modifyMVar, newMVar, readMVar, withMVar ) import Control.DeepSeq ( deepseq ) +import Control.Monad + ( (>=>) ) import Control.Monad.Trans.Except ( ExceptT (..), runExceptT ) import Data.Map.Strict @@ -40,10 +42,10 @@ import Data.Map.Strict import qualified Data.Map.Strict as Map data Database s = Database - { wallet :: Wallet s - , metadata :: WalletMetadata - , txHistory :: Map (Hash "Tx") (Tx, TxMeta) - , xprv :: (Key 'RootK XPrv, Hash "encryption") + { wallet :: !(Wallet s) + , metadata :: !WalletMetadata + , txHistory :: !(Map (Hash "Tx") (Tx, TxMeta)) + , xprv :: !(Maybe (Key 'RootK XPrv, Hash "encryption")) } -- | Instantiate a new in-memory "database" layer that simply stores data in @@ -58,10 +60,10 @@ newDBLayer = do Wallets -----------------------------------------------------------------------} - { createWallet = \key@(PrimaryKey wid) cp meta k -> ExceptT $ do + { createWallet = \key@(PrimaryKey wid) cp meta -> ExceptT $ do let alter = \case Nothing -> - Right $ Just $ Database cp meta mempty k + Right $ Just $ Database cp meta mempty Nothing Just _ -> Left (ErrWalletAlreadyExists wid) cp `deepseq` meta `deepseq` alterMVar db alter key @@ -126,8 +128,16 @@ newDBLayer = do Keystore -----------------------------------------------------------------------} + , putPrivateKey = \key@(PrimaryKey wid) k -> ExceptT $ do + let alter = \case + Nothing -> + Left (ErrNoSuchWallet wid) + Just (Database cp meta txs _) -> + Right $ Just $ Database cp meta txs (Just k) + k `deepseq` alterMVar db alter key + , readPrivateKey = \key -> - fmap xprv . Map.lookup key <$> readMVar db + (Map.lookup key >=> xprv) <$> readMVar db {----------------------------------------------------------------------- Lock diff --git a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs index b9d62da4738..5d0407735b6 100644 --- a/src/Cardano/Wallet/Primitive/AddressDiscovery.hs +++ b/src/Cardano/Wallet/Primitive/AddressDiscovery.hs @@ -44,6 +44,7 @@ module Cardano.Wallet.Primitive.AddressDiscovery -- ** State , SeqState (..) + , mkSeqState , AddressScheme (..) ) where @@ -57,11 +58,12 @@ import Cardano.Wallet.Primitive.AddressDerivation , DerivationType (..) , Index , Key - , Passphrase + , Passphrase (..) , deriveAccountPrivateKey , deriveAddressPrivateKey , deriveAddressPublicKey , keyToAddress + , publicKey ) import Cardano.Wallet.Primitive.Types ( Address, IsOurs (..), invariant ) @@ -356,6 +358,23 @@ data SeqState = SeqState deriving stock (Generic, Show) instance NFData SeqState + +-- | Construct a Sequential state for a wallet. +mkSeqState + :: (Key 'RootK XPrv, Passphrase "encryption") + -> AddressPoolGap + -> SeqState +mkSeqState (rootXPrv, pwd) g = + let + accXPrv = + deriveAccountPrivateKey pwd rootXPrv minBound + extPool = + mkAddressPool (publicKey accXPrv) g [] + intPool = + mkAddressPool (publicKey accXPrv) minBound [] + in + SeqState intPool extPool emptyPendingIxs + -- NOTE -- We have to scan both the internal and external chain. Note that, the -- account discovery algorithm is only specified for the external chain so diff --git a/test/bench/Main.hs b/test/bench/Main.hs index 35b7f2dea79..95f9fdaa3a6 100644 --- a/test/bench/Main.hs +++ b/test/bench/Main.hs @@ -10,17 +10,22 @@ import Cardano.CLI import Cardano.Launcher ( Command (Command), StdStream (..), installSignalHandlers, launch ) import Cardano.Wallet - ( NewWallet (..), WalletLayer (..), mkWalletLayer, unsafeRunExceptT ) + ( WalletLayer (..), mkWalletLayer, unsafeRunExceptT ) import Cardano.Wallet.Network ( NetworkLayer (..), networkTip ) import Cardano.Wallet.Network.HttpBridge ( newNetworkLayer ) import Cardano.Wallet.Primitive.AddressDerivation - ( Passphrase (..) ) + ( Passphrase (..), digest, generateKeyFromSeed, publicKey ) import Cardano.Wallet.Primitive.AddressDiscovery - ( SeqState, mkAddressPoolGap ) + ( AddressScheme (..), SeqState, defaultAddressPoolGap, mkSeqState ) import Cardano.Wallet.Primitive.Types - ( SlotId (..), WalletId, WalletName (..), WalletState (..) ) + ( IsOurs (..) + , SlotId (..) + , WalletId (..) + , WalletName (..) + , WalletState (..) + ) import Control.Arrow ( left ) import Control.Concurrent @@ -28,7 +33,7 @@ import Control.Concurrent import Control.Concurrent.Async ( async, cancel ) import Control.DeepSeq - ( rnf ) + ( NFData, rnf ) import Control.Exception ( bracket, evaluate, throwIO ) import Control.Monad @@ -116,16 +121,20 @@ printResult benchName dur = sayErr . fmt $ " "+|benchName|+": "+|secs dur|+"" -------------------------------------------------------------------------------} {-# ANN bench_restoration ("HLint: ignore Use camelCase" :: String) #-} -bench_restoration :: Network -> NewWallet -> IO () -bench_restoration network nw = withHttpBridge network $ \port -> do +bench_restoration + :: (IsOurs s, AddressScheme s, NFData s, Show s) + => Network + -> (WalletId, WalletName, s) + -> IO () +bench_restoration network (wid, wname, s) = withHttpBridge network $ \port -> do dbLayer <- MVar.newDBLayer networkLayer <- newNetworkLayer networkName port (_, bh) <- unsafeRunExceptT $ networkTip networkLayer - sayErr . fmt $ "Note: the "+|networkName|+" tip is at "+||(bh ^. #slotId)||+"" - let walletLayer = mkWalletLayer dbLayer networkLayer - wallet <- unsafeRunExceptT $ createWallet walletLayer nw - unsafeRunExceptT $ restoreWallet walletLayer wallet - waitForWalletSync walletLayer wallet + sayErr . fmt $ networkName |+ " tip is at " +|| (bh ^. #slotId) ||+ "" + let w = mkWalletLayer dbLayer networkLayer + wallet <- unsafeRunExceptT $ createWallet w wid wname s + unsafeRunExceptT $ restoreWallet w wallet + waitForWalletSync w wallet where networkName = toText network @@ -153,16 +162,16 @@ withHttpBridge network action = bracket start stop (const (action port)) threadDelay 1000000 -- wait for socket to be closed -baseWallet :: NewWallet -baseWallet = NewWallet (Passphrase "") (Passphrase "") - (WalletName "") (Passphrase "") gap20 - where Right gap20 = mkAddressPoolGap 20 - -walletSeq :: NewWallet -walletSeq = baseWallet - { seed = Passphrase "involve key curtain arrest fortune custom lens marine before material wheel glide cause weapon wrap" - , name = WalletName "Benchmark Sequential Wallet" - } +walletSeq :: (WalletId, WalletName, SeqState) +walletSeq = + let + seed = Passphrase "involve key curtain arrest fortune custom lens marine before material wheel glide cause weapon wrap" + xprv = generateKeyFromSeed (seed, mempty) mempty + wid = WalletId $ digest $ publicKey xprv + wname = WalletName "Benchmarks Sequential Wallet" + s = mkSeqState (xprv, mempty) defaultAddressPoolGap + in + (wid, wname, s) prepareNode :: Network -> IO () prepareNode net = do @@ -174,7 +183,7 @@ prepareNode net = do -- | waitForWalletSync - :: WalletLayer SeqState + :: WalletLayer s -> WalletId -> IO () waitForWalletSync walletLayer wid = do diff --git a/test/integration/Cardano/WalletSpec.hs b/test/integration/Cardano/WalletSpec.hs index f2243720fa4..767ad72e1a5 100644 --- a/test/integration/Cardano/WalletSpec.hs +++ b/test/integration/Cardano/WalletSpec.hs @@ -11,15 +11,17 @@ import Prelude import Cardano.Launcher ( Command (..), StdStream (..), launch ) import Cardano.Wallet - ( NewWallet (..), WalletLayer (..), mkWalletLayer, unsafeRunExceptT ) + ( WalletLayer (..), mkWalletLayer, unsafeRunExceptT ) import Cardano.Wallet.Primitive.AddressDerivation - ( Passphrase (..) ) + ( Passphrase (..), digest, generateKeyFromSeed, publicKey ) +import Cardano.Wallet.Primitive.AddressDiscovery + ( mkSeqState ) import Cardano.Wallet.Primitive.Mnemonic ( EntropySize, entropyToBytes, genEntropy ) import Cardano.Wallet.Primitive.Model ( currentTip ) import Cardano.Wallet.Primitive.Types - ( SlotId (..), WalletName (..) ) + ( SlotId (..), WalletId (..), WalletName (..) ) import Control.Concurrent ( threadDelay ) import Control.Concurrent.Async @@ -35,13 +37,11 @@ spec = do before startBridge $ after closeBridge $ do it "A newly created wallet can sync with the chain" $ \(_, wallet) -> do bytes <- entropyToBytes <$> genEntropy @(EntropySize 15) - wid <- unsafeRunExceptT $ createWallet wallet NewWallet - { seed = Passphrase bytes - , secondFactor = mempty - , name = WalletName "My Wallet" - , passphrase = mempty - , gap = minBound - } + let xprv = generateKeyFromSeed (Passphrase bytes, mempty) mempty + wid <- unsafeRunExceptT $ createWallet wallet + (WalletId $ digest $ publicKey xprv) + (WalletName "My Wallet") + (mkSeqState (xprv, mempty) minBound) unsafeRunExceptT $ restoreWallet wallet wid threadDelay 2000000 tip <- currentTip . fst <$> unsafeRunExceptT (readWallet wallet wid) diff --git a/test/unit/Cardano/Wallet/DB/MVarSpec.hs b/test/unit/Cardano/Wallet/DB/MVarSpec.hs index 0826e2bb3d6..100b0ada5c0 100644 --- a/test/unit/Cardano/Wallet/DB/MVarSpec.hs +++ b/test/unit/Cardano/Wallet/DB/MVarSpec.hs @@ -215,8 +215,8 @@ prop_readAfterPut putOp readOp (key, a) = where setup = do db <- liftIO newDBLayer - (cp, meta, xprv) <- pick arbitrary - liftIO $ unsafeRunExceptT $ createWallet db key cp meta xprv + (cp, meta) <- pick arbitrary + liftIO $ unsafeRunExceptT $ createWallet db key cp meta return db prop db = liftIO $ do unsafeRunExceptT $ putOp db key a @@ -268,8 +268,8 @@ prop_readAfterDelete readOp empty key = where setup = do db <- liftIO newDBLayer - (cp, meta, xprv) <- pick arbitrary - liftIO $ unsafeRunExceptT $ createWallet db key cp meta xprv + (cp, meta) <- pick arbitrary + liftIO $ unsafeRunExceptT $ createWallet db key cp meta return db prop db = liftIO $ do unsafeRunExceptT $ removeWallet db key @@ -306,8 +306,8 @@ prop_isolation putA readB readC readD (key, a) = where setup = do db <- liftIO newDBLayer - (cp, meta, txs, xprv) <- pick arbitrary - liftIO $ unsafeRunExceptT $ createWallet db key cp meta xprv + (cp, meta, txs) <- pick arbitrary + liftIO $ unsafeRunExceptT $ createWallet db key cp meta liftIO $ unsafeRunExceptT $ putTxHistory db key txs (b, c, d) <- liftIO $ (,,) <$> readB db key @@ -348,9 +348,9 @@ prop_sequentialPut putOp readOp resolve (KeyValPairs pairs) = ids = map fst pairs setup = do db <- liftIO newDBLayer - (cp, meta, xprv) <- pick arbitrary + (cp, meta) <- pick arbitrary liftIO $ unsafeRunExceptT $ once_ pairs $ \(k, _) -> - createWallet db k cp meta xprv + createWallet db k cp meta return db prop db = liftIO $ do unsafeRunExceptT $ forM_ pairs $ uncurry (putOp db) @@ -384,9 +384,9 @@ prop_parallelPut putOp readOp resolve (KeyValPairs pairs) = ids = map fst pairs setup = do db <- liftIO newDBLayer - (cp, meta, xprv) <- pick arbitrary + (cp, meta) <- pick arbitrary liftIO $ unsafeRunExceptT $ once_ pairs $ \(k, _) -> - createWallet db k cp meta xprv + createWallet db k cp meta return db prop db = liftIO $ do forConcurrently_ pairs $ unsafeRunExceptT . uncurry (putOp db) @@ -395,17 +395,15 @@ prop_parallelPut putOp readOp resolve (KeyValPairs pairs) = -- | Can list created wallets prop_createListWallet - :: KeyValPairs - (PrimaryKey WalletId) - (Wallet DummyState, WalletMetadata, (Key 'RootK XPrv, Hash "encryption")) + :: KeyValPairs (PrimaryKey WalletId) (Wallet DummyState, WalletMetadata) -> Property prop_createListWallet (KeyValPairs pairs) = monadicIO (setup >>= prop) where setup = liftIO newDBLayer prop db = liftIO $ do - res <- once pairs $ \(k, (cp, meta, xprv)) -> - unsafeRunExceptT $ createWallet db k cp meta xprv + res <- once pairs $ \(k, (cp, meta)) -> + unsafeRunExceptT $ createWallet db k cp meta (length <$> listWallets db) `shouldReturn` length res -- | Trying to create a same wallet twice should yield an error @@ -413,32 +411,30 @@ prop_createWalletTwice :: ( PrimaryKey WalletId , Wallet DummyState , WalletMetadata - , (Key 'RootK XPrv, Hash "encryption") ) -> Property -prop_createWalletTwice (key@(PrimaryKey wid), cp, meta, xprv) = +prop_createWalletTwice (key@(PrimaryKey wid), cp, meta) = monadicIO (setup >>= prop) where setup = liftIO newDBLayer prop db = liftIO $ do let err = ErrWalletAlreadyExists wid - runExceptT (createWallet db key cp meta xprv) `shouldReturn` Right () - runExceptT (createWallet db key cp meta xprv) `shouldReturn` Left err + runExceptT (createWallet db key cp meta) `shouldReturn` Right () + runExceptT (createWallet db key cp meta) `shouldReturn` Left err -- | Trying to remove a same wallet twice should yield an error prop_removeWalletTwice :: ( PrimaryKey WalletId , Wallet DummyState , WalletMetadata - , (Key 'RootK XPrv, Hash "encryption") ) -> Property -prop_removeWalletTwice (key@(PrimaryKey wid), cp, meta, xprv) = +prop_removeWalletTwice (key@(PrimaryKey wid), cp, meta) = monadicIO (setup >>= prop) where setup = liftIO $ do db <- newDBLayer - unsafeRunExceptT $ createWallet db key cp meta xprv + unsafeRunExceptT $ createWallet db key cp meta return db prop db = liftIO $ do let err = ErrNoSuchWallet wid diff --git a/test/unit/Cardano/WalletSpec.hs b/test/unit/Cardano/WalletSpec.hs index 72cbf5c58b2..cc422e6dbe1 100644 --- a/test/unit/Cardano/WalletSpec.hs +++ b/test/unit/Cardano/WalletSpec.hs @@ -1,7 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} @@ -14,61 +13,44 @@ module Cardano.WalletSpec import Prelude import Cardano.Wallet - ( NewWallet (..), WalletLayer (..), mkWalletLayer ) + ( WalletLayer (..), mkWalletLayer ) import Cardano.Wallet.DB ( DBLayer, PrimaryKey (..) ) import Cardano.Wallet.DB.MVar ( newDBLayer ) import Cardano.Wallet.Network.HttpBridge ( newNetworkLayer ) -import Cardano.Wallet.Primitive.AddressDerivation - ( Passphrase (..) ) import Cardano.Wallet.Primitive.AddressDiscovery - ( AddressPoolGap, SeqState ) -import Cardano.Wallet.Primitive.Mnemonic - ( Entropy - , EntropySize - , Mnemonic - , MnemonicException (..) - , MnemonicWords - , ambiguousNatVal - , entropyToMnemonic - , mkEntropy - ) + ( AddressScheme (..) ) import Cardano.Wallet.Primitive.Types - ( WalletId (..), WalletName (..) ) + ( Address (..), IsOurs (..), WalletId (..), WalletName (..) ) +import Control.DeepSeq + ( NFData (..) ) import Control.Monad ( replicateM ) import Control.Monad.IO.Class ( liftIO ) import Control.Monad.Trans.Except ( runExceptT ) -import Crypto.Encoding.BIP39 - ( ValidChecksumSize, ValidEntropySize, ValidMnemonicSentence ) import Crypto.Hash ( hash ) import Data.Either ( isLeft, isRight ) import Data.Maybe ( isJust ) +import GHC.Generics + ( Generic ) import Test.Hspec ( Spec, describe, it, shouldBe, shouldNotBe, shouldSatisfy ) import Test.QuickCheck - ( Arbitrary (..) - , InfiniteList (..) - , Property - , arbitraryBoundedEnum - , choose - , property - , vectorOf - ) + ( Arbitrary (..), Property, elements, property ) +import Test.QuickCheck.Arbitrary.Generic + ( genericArbitrary, genericShrink ) import Test.QuickCheck.Monadic ( monadicIO ) import qualified Cardano.Wallet.DB as DB -import qualified Data.ByteArray as BA import qualified Data.ByteString as BS -import qualified Data.ByteString.Char8 as B8 import qualified Data.List as L spec :: Spec @@ -93,7 +75,7 @@ spec = do -------------------------------------------------------------------------------} walletCreationProp - :: NewWallet + :: (WalletId, WalletName, DummyState) -> Property walletCreationProp newWallet = monadicIO $ liftIO $ do (WalletLayerFixture db _wl walletIds) <- setupFixture newWallet @@ -101,15 +83,15 @@ walletCreationProp newWallet = monadicIO $ liftIO $ do resFromDb `shouldSatisfy` isJust walletDoubleCreationProp - :: NewWallet + :: (WalletId, WalletName, DummyState) -> Property -walletDoubleCreationProp newWallet = monadicIO $ liftIO $ do +walletDoubleCreationProp newWallet@(wid, wname, wstate) = monadicIO $ liftIO $ do (WalletLayerFixture _db wl _walletIds) <- setupFixture newWallet - secondTrial <- runExceptT $ createWallet wl newWallet + secondTrial <- runExceptT $ createWallet wl wid wname wstate secondTrial `shouldSatisfy` isLeft walletGetProp - :: NewWallet + :: (WalletId, WalletName, DummyState) -> Property walletGetProp newWallet = monadicIO $ liftIO $ do (WalletLayerFixture _db wl walletIds) <- liftIO $ setupFixture newWallet @@ -117,7 +99,7 @@ walletGetProp newWallet = monadicIO $ liftIO $ do resFromGet `shouldSatisfy` isRight walletGetWrongIdProp - :: (NewWallet, WalletId) + :: ((WalletId, WalletName, DummyState), WalletId) -> Property walletGetWrongIdProp (newWallet, corruptedWalletId) = monadicIO $ liftIO $ do (WalletLayerFixture _db wl _walletIds) <- liftIO $ setupFixture newWallet @@ -125,7 +107,7 @@ walletGetWrongIdProp (newWallet, corruptedWalletId) = monadicIO $ liftIO $ do attempt `shouldSatisfy` isLeft walletIdDeterministic - :: NewWallet + :: (WalletId, WalletName, DummyState) -> Property walletIdDeterministic newWallet = monadicIO $ liftIO $ do (WalletLayerFixture _ _ widsA) <- liftIO $ setupFixture newWallet @@ -133,7 +115,7 @@ walletIdDeterministic newWallet = monadicIO $ liftIO $ do widsA `shouldBe` widsB walletIdInjective - :: (NewWallet, NewWallet) + :: ((WalletId, WalletName, DummyState), (WalletId, WalletName, DummyState)) -> Property walletIdInjective (walletA, walletB) = monadicIO $ liftIO $ do (WalletLayerFixture _ _ widsA) <- liftIO $ setupFixture walletA @@ -144,71 +126,50 @@ walletIdInjective (walletA, walletB) = monadicIO $ liftIO $ do Tests machinery, Arbitrary instances -------------------------------------------------------------------------------} -data WalletLayerFixture = WalletLayerFixture { - _fixtureDBLayer :: DBLayer IO SeqState - , _fixtureWalletLayer :: WalletLayer SeqState +data WalletLayerFixture = WalletLayerFixture + { _fixtureDBLayer :: DBLayer IO DummyState + , _fixtureWalletLayer :: WalletLayer DummyState , _fixtureWallet :: [WalletId] } setupFixture - :: NewWallet + :: (WalletId, WalletName, DummyState) -> IO WalletLayerFixture -setupFixture newWallet = do +setupFixture (wid, wname, wstate) = do db <- newDBLayer network <- newNetworkLayer "testnetwork" 8000 let wl = mkWalletLayer db network - res <- runExceptT $ createWallet wl newWallet + res <- runExceptT $ createWallet wl wid wname wstate let wal = case res of Left _ -> [] Right walletId -> [walletId] pure $ WalletLayerFixture db wl wal -instance Arbitrary NewWallet where - -- No shrinking - arbitrary = NewWallet - <$> arbitrary - <*> arbitrary - <*> pure (WalletName "My Wallet") - <*> arbitrary - <*> arbitrary - -instance - ( ValidEntropySize n - , ValidChecksumSize n csz - ) => Arbitrary (Entropy n) where - arbitrary = - let - size = fromIntegral $ ambiguousNatVal @n - entropy = - mkEntropy @n . B8.pack <$> vectorOf (size `quot` 8) arbitrary - in - either (error . show . UnexpectedEntropyError) id <$> entropy - -instance - ( n ~ EntropySize mw - , mw ~ MnemonicWords n - , ValidChecksumSize n csz - , ValidEntropySize n - , ValidMnemonicSentence mw - , Arbitrary (Entropy n) - ) => Arbitrary (Mnemonic mw) where - arbitrary = - entropyToMnemonic <$> arbitrary @(Entropy n) - -instance Arbitrary (Passphrase goal) where - shrink (Passphrase "") = [] - shrink (Passphrase _ ) = [Passphrase ""] - arbitrary = do - n <- choose (0, 32) - InfiniteList bytes _ <- arbitrary - return $ Passphrase $ BA.convert $ BS.pack $ take n bytes +data DummyState = DummyState + deriving (Generic, Show, Eq) -instance Arbitrary AddressPoolGap where - shrink _ = [] - arbitrary = arbitraryBoundedEnum +instance NFData DummyState + +instance Arbitrary DummyState where + shrink = genericShrink + arbitrary = genericArbitrary + +instance IsOurs DummyState where + isOurs _ s = (True, s) + +instance AddressScheme DummyState where + keyFrom _ _ _ = Nothing + nextChangeAddress s = (Address "dummy", s) instance Arbitrary WalletId where shrink _ = [] arbitrary = do bytes <- BS.pack <$> replicateM 16 arbitrary return $ WalletId (hash bytes) + +instance Arbitrary WalletName where + shrink _ = [] + arbitrary = elements + [ WalletName "My Wallet" + , WalletName mempty + ] From f63f8e4725ced1704b915e15fc75fecabcfa9c91 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 26 Apr 2019 16:52:15 +0200 Subject: [PATCH 2/4] Add stress restoration benchmarks This creates a new 'special' address scheme that accept a given proportion of addresses on the chain (e.g. 50%). This allows us to artificially create very big wallets and observe how the wallet backend survive and behave. Co-authored-by: Rodney Lorrimar --- cardano-wallet.cabal | 5 ++ .../Wallet/Primitive/AddressDiscovery/Any.hs | 68 +++++++++++++++++++ test/bench/Main.hs | 57 ++++++++++++---- 3 files changed, 115 insertions(+), 15 deletions(-) create mode 100644 test/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs diff --git a/cardano-wallet.cabal b/cardano-wallet.cabal index 77ca70fc17f..0ab1f6aace2 100644 --- a/cardano-wallet.cabal +++ b/cardano-wallet.cabal @@ -316,9 +316,13 @@ benchmark restore base , ansi-terminal , async + , bytestring , cardano-wallet + , containers , criterion-measurement + , cryptonite , deepseq + , digest , docopt , fmt , generic-lens @@ -337,6 +341,7 @@ benchmark restore other-modules: Cardano.CLI Cardano.Launcher + Cardano.Wallet.Primitive.AddressDiscovery.Any if os(windows) build-depends: Win32 other-modules: Cardano.Launcher.Windows diff --git a/test/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs b/test/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs new file mode 100644 index 00000000000..457d080cc19 --- /dev/null +++ b/test/bench/Cardano/Wallet/Primitive/AddressDiscovery/Any.hs @@ -0,0 +1,68 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE TypeFamilies #-} + +-- | +-- Copyright: © 2018-2019 IOHK +-- License: MIT +-- +-- Custom address discovery schemes used for testing and benchmarking. +-- + +module Cardano.Wallet.Primitive.AddressDiscovery.Any + ( AnyAddressState (..) + , initAnyState + ) where + +import Prelude + +import Cardano.Wallet.Primitive.AddressDiscovery + ( AddressScheme (..) ) +import Cardano.Wallet.Primitive.Types + ( Address (..), IsOurs (..), WalletId (..), WalletName (..) ) +import Control.DeepSeq + ( NFData ) +import Crypto.Hash + ( hash ) +import Data.Digest.CRC32 + ( crc32 ) +import Data.Text + ( Text ) +import Data.Word + ( Word32 ) +import GHC.Generics + ( Generic ) + +import qualified Data.ByteString.Char8 as B8 + +---------------------------------------------------------------------------- + +-- | Any Address Derivation +-- +-- An arbitrary fraction of addreses are recognized as "ours". This is done by +-- looking at a checksum of the address. +newtype AnyAddressState = AnyAddressState + { oursProportion :: Double + } + deriving stock (Generic, Show) + +instance NFData AnyAddressState + +instance IsOurs AnyAddressState where + isOurs (Address addr) s@(AnyAddressState p) = (crc32 addr < p', s) + where + p' = floor (fromIntegral (maxBound :: Word32) * p) + +instance AddressScheme AnyAddressState where + keyFrom _ _ _ = Nothing + nextChangeAddress _ = error + "AddressScheme.nextChangeAddress: trying to generate change for \ + \an incompatible scheme 'AnyAddressState'. Please don't." + +initAnyState :: Text -> Double -> (WalletId, WalletName, AnyAddressState) +initAnyState wname p = (walletId cfg, WalletName wname, cfg) + where cfg = AnyAddressState p + +walletId :: Show a => a -> WalletId +walletId = WalletId . hash . B8.pack . show diff --git a/test/bench/Main.hs b/test/bench/Main.hs index 95f9fdaa3a6..431e33f18af 100644 --- a/test/bench/Main.hs +++ b/test/bench/Main.hs @@ -19,9 +19,14 @@ import Cardano.Wallet.Primitive.AddressDerivation ( Passphrase (..), digest, generateKeyFromSeed, publicKey ) import Cardano.Wallet.Primitive.AddressDiscovery ( AddressScheme (..), SeqState, defaultAddressPoolGap, mkSeqState ) +import Cardano.Wallet.Primitive.AddressDiscovery.Any + ( AnyAddressState, initAnyState ) +import Cardano.Wallet.Primitive.Model + ( totalBalance, totalUTxO ) import Cardano.Wallet.Primitive.Types ( IsOurs (..) , SlotId (..) + , UTxO (..) , WalletId (..) , WalletName (..) , WalletState (..) @@ -37,7 +42,7 @@ import Control.DeepSeq import Control.Exception ( bracket, evaluate, throwIO ) import Control.Monad - ( mapM_ ) + ( forM, mapM_ ) import Control.Monad.Fail ( MonadFail ) import Control.Monad.Trans.Except @@ -64,6 +69,7 @@ import System.IO ( BufferMode (..), hSetBuffering, stderr, stdout ) import qualified Cardano.Wallet.DB.MVar as MVar +import qualified Data.Map.Strict as Map import qualified Data.Text as T -- | Run all available benchmarks. Can accept one argument that is a target @@ -80,7 +86,32 @@ main = do runBenchmarks [ bench ("restore " <> toText network <> " seq") (bench_restoration network walletSeq) + , bench ("restore " <> toText network <> " 10% ownership") + (bench_restoration network wallet10p) + , bench ("restore " <> toText network <> " 50% ownership") + (bench_restoration network wallet50p) ] + where + walletSeq :: (WalletId, WalletName, SeqState) + walletSeq = + let + seed = Passphrase + "involve key curtain arrest fortune custom lens marine before \ + \material wheel glide cause weapon wrap" + xprv = generateKeyFromSeed (seed, mempty) mempty + wid = WalletId $ digest $ publicKey xprv + wname = WalletName "Benchmark Sequential Wallet" + s = mkSeqState (xprv, mempty) defaultAddressPoolGap + in + (wid, wname, s) + + wallet10p :: (WalletId, WalletName, AnyAddressState) + wallet10p = + initAnyState "Benchmark 10% Wallet" 0.1 + + wallet50p :: (WalletId, WalletName, AnyAddressState) + wallet50p = + initAnyState "Benchmark 50% Wallet" 0.5 -- | Very simplistic benchmark argument parser. If anything more is ever needed, -- it's probably a good idea to go for `optparse-application` or similar for a @@ -98,7 +129,9 @@ parseArgs = \case runBenchmarks :: [IO (Text, Double)] -> IO () runBenchmarks bs = do initializeTime - rs <- sequence bs + -- NOTE: Adding an artificial delay between successive runs to get a better + -- output for the heap profiling. + rs <- forM bs $ \io -> io <* let _2s = 2000000 in threadDelay _2s sayErr "\n\nAll results:" mapM_ (uncurry printResult) rs @@ -135,6 +168,11 @@ bench_restoration network (wid, wname, s) = withHttpBridge network $ \port -> do wallet <- unsafeRunExceptT $ createWallet w wid wname s unsafeRunExceptT $ restoreWallet w wallet waitForWalletSync w wallet + (wallet', _) <- unsafeRunExceptT $ readWallet w wid + sayErr "Wallet restored!" + sayErr . fmt $ "Balance: " +|| totalBalance wallet' ||+ " lovelace" + sayErr . fmt $ "UTxO: " +|| Map.size (getUTxO $ totalUTxO wallet') ||+ " entries" + unsafeRunExceptT $ removeWallet w wid where networkName = toText network @@ -161,18 +199,6 @@ withHttpBridge network action = bracket start stop (const (action port)) cancel handle threadDelay 1000000 -- wait for socket to be closed - -walletSeq :: (WalletId, WalletName, SeqState) -walletSeq = - let - seed = Passphrase "involve key curtain arrest fortune custom lens marine before material wheel glide cause weapon wrap" - xprv = generateKeyFromSeed (seed, mempty) mempty - wid = WalletId $ digest $ publicKey xprv - wname = WalletName "Benchmarks Sequential Wallet" - s = mkSeqState (xprv, mempty) defaultAddressPoolGap - in - (wid, wname, s) - prepareNode :: Network -> IO () prepareNode net = do sayErr . fmt $ "Syncing "+|toText net|+" node... " @@ -181,7 +207,8 @@ prepareNode net = do waitForNodeSync network (toText net) logQuiet sayErr . fmt $ "Completed sync of "+|toText net|+" up to "+||sl||+"" --- | +-- | Regularly poll the wallet to monitor it's syncing progress. Block until the +-- wallet reaches 100%. waitForWalletSync :: WalletLayer s -> WalletId From 4bd416bf2dd23ab65cef33484b1280fcb0bf8b85 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 26 Apr 2019 17:18:02 +0200 Subject: [PATCH 3/4] add extra property tests for the 'putPrivateKey' DB function --- test/unit/Cardano/Wallet/DB/MVarSpec.hs | 47 ++++++++++++++++++------- 1 file changed, 35 insertions(+), 12 deletions(-) diff --git a/test/unit/Cardano/Wallet/DB/MVarSpec.hs b/test/unit/Cardano/Wallet/DB/MVarSpec.hs index 100b0ada5c0..7cef9289c24 100644 --- a/test/unit/Cardano/Wallet/DB/MVarSpec.hs +++ b/test/unit/Cardano/Wallet/DB/MVarSpec.hs @@ -68,6 +68,8 @@ import Data.Word ( Word32 ) import GHC.Generics ( Generic ) +import System.IO.Unsafe + ( unsafePerformIO ) import Test.Hspec ( Spec, describe, it, shouldBe, shouldReturn ) import Test.QuickCheck @@ -80,6 +82,7 @@ import Test.QuickCheck , choose , cover , elements + , generate , genericShrink , oneof , property @@ -114,6 +117,8 @@ spec = do (property $ prop_readAfterPut putWalletMeta readWalletMeta) it "Tx History" (property $ prop_readAfterPut putTxHistory readTxHistoryF) + it "Private Key" + (property $ prop_readAfterPut putPrivateKey readPrivateKey) describe "can't put before wallet exists" $ do it "Checkpoint" @@ -122,6 +127,8 @@ spec = do (property $ prop_putBeforeInit putWalletMeta readWalletMeta Nothing) it "Tx History" (property $ prop_putBeforeInit putTxHistory readTxHistoryF (pure mempty)) + it "Private Key" + (property $ prop_putBeforeInit putPrivateKey readPrivateKey Nothing) describe "put doesn't affect other resources" $ do it "Checkpoint vs Wallet Metadata & Tx History & Private Key" @@ -160,6 +167,8 @@ spec = do (checkCoverage $ prop_sequentialPut putWalletMeta readWalletMeta lrp) it "Tx History" (checkCoverage $ prop_sequentialPut putTxHistory readTxHistoryF unions) + it "Private Key" + (checkCoverage $ prop_sequentialPut putPrivateKey readPrivateKey lrp) describe "parallel puts replace values in _any_ order" $ do it "Checkpoint" @@ -171,6 +180,9 @@ spec = do it "Tx History" (checkCoverage $ prop_parallelPut putTxHistory readTxHistoryF (length . unions @(Map (Hash "Tx") (Tx, TxMeta)))) + it "Private Key" + (checkCoverage $ prop_parallelPut putPrivateKey readPrivateKey + (length . lrp @Maybe)) where -- | Wrap the result of 'readTxHistory' in an arbitrary identity Applicative readTxHistoryF @@ -514,18 +526,7 @@ instance Arbitrary WalletMetadata where instance Arbitrary (Key 'RootK XPrv) where shrink _ = [] - arbitrary = do - (s, g, e) <- (,,) - <$> genPassphrase @"seed" (0, 32) - <*> genPassphrase @"generation" (0, 16) - <*> genPassphrase @"encryption" (0, 16) - return $ generateKeyFromSeed (s, g) e - where - genPassphrase :: (Int, Int) -> Gen (Passphrase purpose) - genPassphrase range = do - n <- choose range - InfiniteList bytes _ <- arbitrary - return $ Passphrase $ BA.convert $ BS.pack $ take n bytes + arbitrary = elements rootKeys instance Arbitrary (Hash "encryption") where shrink _ = [] @@ -540,3 +541,25 @@ instance Show XPrv where -- Necessary unsound Eq instance for QuickCheck properties instance Eq XPrv where a == b = unXPrv a == unXPrv b + +genRootKeys :: Gen (Key 'RootK XPrv) +genRootKeys = do + (s, g, e) <- (,,) + <$> genPassphrase @"seed" (0, 32) + <*> genPassphrase @"generation" (0, 16) + <*> genPassphrase @"encryption" (0, 16) + return $ generateKeyFromSeed (s, g) e + where + genPassphrase :: (Int, Int) -> Gen (Passphrase purpose) + genPassphrase range = do + n <- choose range + InfiniteList bytes _ <- arbitrary + return $ Passphrase $ BA.convert $ BS.pack $ take n bytes + +-- Properties above are quite heavy on the generation of values, althrough for +-- private keys, it isn't particularly useful / relevant to generate many of +-- them as they're really treated as an opaque type. +-- Instead, we generate them once, and picks from the list. +rootKeys :: [Key 'RootK XPrv] +rootKeys = unsafePerformIO $ generate (vectorOf 10 genRootKeys) +{-# NOINLINE rootKeys #-} From e3964f2ce6b7e2c2b1098186f9625c7b529bfd72 Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 26 Apr 2019 17:40:43 +0200 Subject: [PATCH 4/4] slightly review README file (move testing bits to Wiki & document benchmark) --- README.md | 56 +++++++------------------------------------------------ 1 file changed, 7 insertions(+), 49 deletions(-) diff --git a/README.md b/README.md index 5a648e81bd4..7d030f80119 100644 --- a/README.md +++ b/README.md @@ -26,7 +26,7 @@ It can be used as a component of a frontend such as interface for wallets. Most users who would like to use Cardano should start with Daedalus. -## Development +## Overview This source code repository contains the next major version of Cardano Wallet, which has been completely rewritten for the @@ -46,57 +46,15 @@ $ stack build --test --no-run-tests ## How to test -#### unit - -``` -$ stack test cardano-wallet:unit -``` - -#### integration - -##### pre-requisites - -1. Install our fork of [cardano-http-bridge](https://github.com/KtorZ/cardano-http-bridge) - -``` -$ cargo install --branch cardano-wallet-integration --git https://github.com/KtorZ/cardano-http-bridge.git -``` - -2. Install [cardano-sl@cardano-node-simple](https://github.com/input-output-hk/cardano-sl) - -``` -$ git clone git@github.com:input-output-hk/cardano-sl.git -$ cd cardano-sl -$ stack install cardano-sl-node:exe:cardano-node-simple -``` - -Alternatively, if you're running on linux, you may use a pre-compiled version: - -``` -$ curl -L -o cardano-node-simple-3.0.1.tar.gz https://raw.githubusercontent.com/input-output-hk/cardano-wallet/master/test/data/cardano-node-simple/cardano-node-simple-3.0.1.tar.gz -$ tar xzf cardano-node-simple-3.0.1.tar.gz -C /usr/local/bin && rm cardano-node-simple-3.0.1.tar.gz -``` - -3. Import the initial testnet chain bootstrap for the `cardano-http-bridge` - -``` -$ curl -L -o hermes-testnet.tar.gz https://raw.githubusercontent.com/input-output-hk/cardano-wallet/master/test/data/cardano-http-bridge/hermes-testnet.tar.gz -$ tar xzf hermes-testnet.tar.gz -C $HOME && rm hermes-testnet.tar.gz -``` - -##### test - -``` -$ stack test cardano-wallet:integration -``` - +See [Wiki - Testing](https://github.com/input-output-hk/cardano-wallet/wiki/Testing) ## Documentation - * Users of the Cardano Wallet API can refer to the [API Documentation](https://input-output-hk.github.io/cardano-wallet/api/). - * Development-related information can be found in the [Wiki](https://github.com/input-output-hk/cardano-wallet/wiki). - * To help understand the source code, refer to the [Haddock Documentation](https://input-output-hk.github.io/cardano-wallet/haddock/). - +| Link | Audience | +| --- | --- | +| [API Documentation](https://input-output-hk.github.io/cardano-wallet/api/) | Users of the Cardano Wallet API | +| [Haddock Documentation](https://input-output-hk.github.io/cardano-wallet/haddock/) | Haskell Developers using the `cardano-wallet` as a library | +| [Wiki](https://github.com/input-output-hk/cardano-wallet/wiki) | Anyone interested in the project and our development process |