Add 'DB' type and documentation

lib/wallet/src/Cardano/Wallet/DB.hs

@@ -1,11 +1,16 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
+{-# LANGUAGE TypeFamilies #-}
 
 -- |
 -- Copyright: © 2018-2020 IOHK
@@ -31,12 +36,17 @@ module Cardano.Wallet.DB
     , DBPrivateKey (..)
     , mkDBLayerFromParts
 
+    -- * General QueryStore abstraction
+    , QueryStore (..)
+    , untry
+
       -- * Errors
     , ErrBadFormat(..)
     , ErrWalletAlreadyExists(..)
     , ErrNoSuchTransaction (..)
     , ErrRemoveTx (..)
     , ErrPutLocalTxSubmission (..)
+    , queryStoreProperty
     ) where
 
 import Prelude
@@ -79,12 +89,16 @@ import Cardano.Wallet.Primitive.Types.Tx
     , TxMeta (..)
     , TxStatus
     )
+import Control.Exception
+    ( SomeException (..), throwIO )
 import Control.Monad.IO.Class
     ( MonadIO, liftIO )
 import Control.Monad.Trans.Except
     ( ExceptT (..), runExceptT )
 import Data.DBVar
-    ( DBVar )
+    ( DBVar, Store (..) )
+import Data.Delta
+    ( Delta (..) )
 import Data.Functor
     ( (<&>) )
 import Data.Generics.Internal.VL
@@ -115,7 +129,7 @@ data DBFactory m s k = DBFactory
         -- ^ List existing wallet database found on disk.
     }
 
--- | A Database interface for storing various things in a DB. In practice,
+-- | A Database interface for storing various things in a QueryStore. In practice,
 -- we'll need some extra constraints on the wallet state that allows us to
 -- serialize and unserialize it (e.g. @forall s. (Serialize s) => ...@)
 --
@@ -168,7 +182,7 @@ data DBLayer m s k = forall stm. (MonadIO stm, MonadFail stm) => DBLayer
 
     , listWallets
         :: stm [WalletId]
-        -- ^ Get the list of all known wallets in the DB, possibly empty.
+        -- ^ Get the list of all known wallets in the QueryStore, possibly empty.
 
     , walletsDB
         :: DBVar stm (DeltaMap WalletId (DeltaWalletState s))
@@ -513,7 +527,7 @@ data DBWallets stm s = DBWallets
 
     , listWallets_
         :: stm [WalletId]
-        -- ^ Get the list of all known wallets in the DB, possibly empty.
+        -- ^ Get the list of all known wallets in the QueryStore, possibly empty.
 
     , hasWallet_
         :: WalletId
@@ -699,6 +713,64 @@ data DBPrivateKey stm k = DBPrivateKey
         -- hash.
     }
 
+{-----------------------------------------------------------------------------
+    General QueryStore abstraction
+------------------------------------------------------------------------------}
+{- |
+A 'QueryStore' is a storage facility for a Haskell value of type @a ~@'Base'@ da@.
+Typical use cases are a file or a database on the hard disk.
+
+
+
+In addition, 'QueryStore' also allows reading /parts/ of the data through 'queryS'
+— often, it is more efficient to read part of the data from disk
+rather than first load the entire data through 'loadDB' into memory,
+and then filtering the parts of interest.
+
+The parts of the data are expressed through a type constructor @read@
+— typically implemented as a GADT representing different read operations.
+We expect that there is a function @query :: read b -> World a -> b@ which
+applies the operation to a plain value.
+Then, 'queryS' must satisfy
+
+> ∀ qs read.  query read <$> (loadS . store) qs  =  queryS qs read
+
+In other words, loading the value into memory and reading a part
+is equivalent to reading it directly.
+For notational simplicity, we make no attempt at codifying this expectation
+in Haskell.
+
+We stress that all these operations — especially 'updateS' and 'queryS' —
+only exist in order to express control over the storage location
+and in order to enable an efficient implementation.
+Conceptually, a 'QueryStore' is very plain — it stores a single value of type
+@a ~@'Base'@ da@, nothing more, nothing less.
+(If you want to store multiple values, consider storing a 'Set' or 'Map'.)
+-}
+data QueryStore m qa da = QueryStore
+    { store :: Store m da
+    , queryS :: forall b. qa b -> m b
+    }
+
+class Query qa where
+    type family World qa
+    query :: qa b -> World qa -> b
+
+queryStoreProperty
+    :: (Monad m, Eq b, Query qa, MonadFail m, Base da ~ World qa)
+    => qa b
+    -> QueryStore m qa da
+    -> m Bool
+queryStoreProperty r QueryStore{store, queryS} = do
+    Right z <- loadS store
+    (query r z ==) <$> queryS r
+
+-- | Helper function to retry the exception reported by 'loadS'.
+untry :: MonadIO m => m (Either SomeException a) -> m a
+untry action = action >>= liftIO . \case
+    Left (SomeException e) -> throwIO e
+    Right a -> pure a
+
 {-----------------------------------------------------------------------------
     Helper functions
 ------------------------------------------------------------------------------}