Merge pull request #3170 from input-output-hk/feature/cbr-315-pure-ge…

…tters-for-the-kernel

[CBR-315] Have only pure getters for the Kernel's DB

wallet-new/cardano-sl-wallet-new.cabal

@@ -77,6 +77,7 @@ library
                        Cardano.Wallet.Kernel.DB.HdWallet.Read
                        Cardano.Wallet.Kernel.DB.HdWallet.Update
                        Cardano.Wallet.Kernel.DB.InDb
+                       Cardano.Wallet.Kernel.DB.Read
                        Cardano.Wallet.Kernel.DB.Resolved
                        Cardano.Wallet.Kernel.DB.Spec
                        Cardano.Wallet.Kernel.DB.Spec.Read

wallet-new/src/Cardano/Wallet/Kernel.hs

@@ -9,9 +9,8 @@
 module Cardano.Wallet.Kernel (
     -- * Passive wallet
     PassiveWallet -- opaque
+  , DB -- opaque
   , WalletId
-  , accountUtxo
-  , accountTotalBalance
   , applyBlock
   , applyBlocks
   , bracketPassiveWallet
@@ -20,6 +19,10 @@ module Cardano.Wallet.Kernel (
   , walletLogMessage
   , walletPassive
   , wallets
+    -- * The only effectful getter you will ever need
+  , getWalletSnapshot
+    -- * Pure getters acting on a DB snapshot
+  , module Getters
     -- * Active wallet
   , ActiveWallet -- opaque
   , bracketActiveWallet
@@ -34,8 +37,6 @@ import           Control.Lens.TH
 import qualified Data.Map.Strict as Map
 import           Data.Time.Clock.POSIX (getPOSIXTime)
 
-import           Formatting (build, sformat)
-
 import           System.Wlog (Severity (..))
 
 import           Data.Acid (AcidState)
@@ -49,23 +50,24 @@ import           Cardano.Wallet.Kernel.Types (WalletESKs, WalletId (..))
 
 import           Cardano.Wallet.Kernel.DB.AcidState (ApplyBlock (..),
                      CancelPending (..), CreateHdWallet (..), DB,
-                     NewPending (..), NewPendingError, Snapshot (..),
-                     dbHdWallets, defDB)
+                     NewPending (..), NewPendingError, Snapshot (..), defDB)
 import           Cardano.Wallet.Kernel.DB.BlockMeta (BlockMeta (..))
 import           Cardano.Wallet.Kernel.DB.HdWallet
 import qualified Cardano.Wallet.Kernel.DB.HdWallet as HD
 import qualified Cardano.Wallet.Kernel.DB.HdWallet.Create as HD
-import           Cardano.Wallet.Kernel.DB.HdWallet.Read (HdQueryErr)
 import           Cardano.Wallet.Kernel.DB.InDb
 import           Cardano.Wallet.Kernel.DB.Resolved (ResolvedBlock)
 import           Cardano.Wallet.Kernel.DB.Spec (singletonPending)
-import qualified Cardano.Wallet.Kernel.DB.Spec.Read as Spec
 import           Cardano.Wallet.Kernel.Submission (Cancelled, WalletSubmission,
                      addPending, defaultResubmitFunction, exponentialBackoff,
                      newWalletSubmission, tick)
 import           Cardano.Wallet.Kernel.Submission.Worker (tickSubmissionLayer)
 
-import           Pos.Core (AddressHash, Coin, Timestamp (..), TxAux (..))
+-- Handy re-export of the pure getters
+
+import           Cardano.Wallet.Kernel.DB.Read as Getters
+
+import           Pos.Core (AddressHash, Timestamp (..), TxAux (..))
 
 import           Pos.Core.Chrono (OldestFirst)
 import           Pos.Crypto (EncryptedSecretKey, PublicKey, hash)
@@ -299,25 +301,6 @@ cancelPending :: PassiveWallet -> Cancelled -> IO ()
 cancelPending passiveWallet cancelled =
     update' (passiveWallet ^. wallets) $ CancelPending (fmap InDb cancelled)
 
-{-------------------------------------------------------------------------------
-  Wallet Account read-only API
--------------------------------------------------------------------------------}
-
-walletQuery' :: forall e a. (Buildable e)
-             => PassiveWallet
-             -> HdQueryErr e a
-             -> IO a
-walletQuery' pw qry= do
-    snapshot <- query' (pw ^. wallets) Snapshot
-    let res = qry (snapshot ^. dbHdWallets)
-    either err return res
-    where
-        err = error . sformat build
-
-accountUtxo :: PassiveWallet -> HdAccountId -> IO Utxo
-accountUtxo pw accountId
-    = walletQuery' pw (Spec.queryAccountUtxo accountId)
-
-accountTotalBalance :: PassiveWallet -> HdAccountId -> IO Coin
-accountTotalBalance pw accountId
-    = walletQuery' pw (Spec.queryAccountTotalBalance accountId)
+-- | The only effectful query on this 'PassiveWallet'.
+getWalletSnapshot :: PassiveWallet -> IO DB
+getWalletSnapshot pw = query' (pw ^. wallets) Snapshot

wallet-new/src/Cardano/Wallet/Kernel/DB/AcidState.hs

@@ -286,6 +286,9 @@ deleteHdAccount accId = runUpdate' . zoom dbHdWallets $
   Acid-state magic
 -------------------------------------------------------------------------------}
 
+-- | Reads the full DB. This is and @must@ be the only 'Query' ever exported
+-- by this module. All the getters exposed for the kernel @must@ take a 'DB'
+-- as input and be completely pure.
 snapshot :: Query DB DB
 snapshot = ask
 

wallet-new/src/Cardano/Wallet/Kernel/DB/Read.hs

@@ -0,0 +1,54 @@
+module Cardano.Wallet.Kernel.DB.Read (
+    -- * Read-only, pure getters
+    accountUtxo
+  , accountTotalBalance
+  ) where
+
+import           Universum
+
+import           Data.Text.Buildable (Buildable)
+import           Formatting (build, sformat)
+
+import           Pos.Core (Coin)
+import           Pos.Txp (Utxo)
+
+import           Cardano.Wallet.Kernel.DB.AcidState (DB, dbHdWallets)
+import           Cardano.Wallet.Kernel.DB.HdWallet (HdAccountId)
+import           Cardano.Wallet.Kernel.DB.HdWallet.Read (HdQueryErr)
+import qualified Cardano.Wallet.Kernel.DB.Spec.Read as Spec
+
+{-------------------------------------------------------------------------------
+                              Wallet getters
+
+  The @only@ effectful function we expose is 'getWalletSnapshot', which reads
+  the full DB 'Snapshot' and returns it.
+  All the other getters are completely pure and take the 'Snapshot' as input,
+  so that users of the wallet are forced to re-use the same 'Snapshot' in case
+  they want to read the state of the wallet multiple times within the same
+  code block / handler.
+
+-------------------------------------------------------------------------------}
+
+walletQuery' :: forall e a. (Buildable e)
+             => DB
+             -> HdQueryErr e a
+             -> a
+walletQuery' snapshot qry= do
+    let res = qry (snapshot ^. dbHdWallets)
+    either err identity res
+    where
+        err = error . sformat build
+
+{-------------------------------------------------------------------------------
+  Pure getters on the 'DbSnapshot'.
+-------------------------------------------------------------------------------}
+
+-- | Returns the Utxo for the input 'HdAccountId'.
+accountUtxo :: DB -> HdAccountId -> Utxo
+accountUtxo snapshot accountId
+    = walletQuery' snapshot (Spec.queryAccountUtxo accountId)
+
+-- | Returns the total balance for this 'HdAccountId'.
+accountTotalBalance :: DB -> HdAccountId -> Coin
+accountTotalBalance snapshot accountId
+    = walletQuery' snapshot (Spec.queryAccountTotalBalance accountId)

wallet-new/test/unit/Wallet/Inductive/Cardano.hs

@@ -212,8 +212,9 @@ equivalentT activeWallet (pk,esk) = \mkWallet w ->
                      -> HD.HdAccountId
                      -> TranslateT (EquivalenceViolation h) m ()
     checkWalletState ctxt@InductiveCtxt{..} accountId = do
-        cmp "utxo"          utxo         (`Kernel.accountUtxo` accountId)
-        cmp "totalBalance"  totalBalance (`Kernel.accountTotalBalance` accountId)
+        snapshot <- liftIO (Kernel.getWalletSnapshot passiveWallet)
+        cmp "utxo"          utxo         (snapshot `Kernel.accountUtxo` accountId)
+        cmp "totalBalance"  totalBalance (snapshot `Kernel.accountTotalBalance` accountId)
         -- TODO: check other properties
       where
         cmp :: ( Interpret h a
@@ -223,12 +224,11 @@ equivalentT activeWallet (pk,esk) = \mkWallet w ->
                )
             => Text
             -> (Wallet h Addr -> a)
-            -> (Kernel.PassiveWallet -> IO (Interpreted a))
+            -> Interpreted a
             -> TranslateT (EquivalenceViolation h) m ()
-        cmp fld f g = do
+        cmp fld f kernel = do
           let dsl = f inductiveCtxtWallet
           translated <- toCardano ctxt fld dsl
-          kernel     <- liftIO $ g passiveWallet
 
           unless (translated == kernel) $
             throwError EquivalenceViolation {