Add Cardano.Wallet.Deposit.REST module

lib/customer-deposit-wallet/customer-deposit-wallet.cabal

@@ -83,6 +83,7 @@ library
     Cardano.Wallet.Deposit.Pure.UTxOHistory
     Cardano.Wallet.Deposit.Pure.Submissions
     Cardano.Wallet.Deposit.Read
+    Cardano.Wallet.Deposit.REST
     Cardano.Wallet.Deposit.Write
 
 test-suite scenario

lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/REST.hs

@@ -0,0 +1,189 @@
+-- |
+-- Copyright: © 2024 Cardano Foundation
+-- License: Apache-2.0
+--
+-- 'IO'-based interface to the Deposit Wallet
+-- where the wallet is treated as a mutable resource (~ REST).
+-- This interface can be mapped one-to-one to a HTTP interface.
+module Cardano.Wallet.Deposit.REST
+    ( -- * Types
+      WalletResource
+    , withWalletResource
+    , WalletResourceM
+    , runWalletResourceM
+
+      -- * Operations
+
+      -- ** Initialization
+    , putWallet
+
+      -- ** Mapping between customers and addresses
+    , listCustomers
+    , createAddress
+
+      -- ** Reading from the blockchain
+    , getWalletTip
+    , availableBalance
+    , getCustomerHistory
+    , getCustomerHistories
+
+      -- ** Writing to the blockchain
+    , createPayment
+    , getBIP32PathsForOwnedInputs
+    , signTxBody
+    ) where
+
+import Prelude
+
+import Cardano.Crypto.Wallet
+    ( XPub
+    )
+import Cardano.Wallet.Address.BIP32
+    ( BIP32Path
+    )
+import Cardano.Wallet.Deposit.Pure
+    ( Customer
+    , Word31
+    )
+import Cardano.Wallet.Deposit.Read
+    ( Address
+    )
+import Control.Monad.Trans.Except
+    ( ExceptT (..)
+    , runExceptT
+    )
+import Control.Monad.Trans.Reader
+    ( ReaderT (..)
+    )
+import Data.Bifunctor
+    ( first
+    )
+
+import qualified Cardano.Wallet.Deposit.IO as WalletIO
+import qualified Cardano.Wallet.Deposit.IO.Resource as Resource
+import qualified Cardano.Wallet.Deposit.Pure as Wallet
+import qualified Cardano.Wallet.Deposit.Read as Read
+import qualified Cardano.Wallet.Deposit.Write as Write
+import qualified Data.Map as Map
+
+{-----------------------------------------------------------------------------
+    Types
+------------------------------------------------------------------------------}
+
+-- | Mutable resource that may hold a 'WalletInstance'.
+type WalletResource = Resource.Resource WalletIO.WalletInstance
+
+{-
+    -- Find the resource from the file system
+    -- or create a new one.
+    -- withWalletInit
+    -- withWalletLoad
+
+    -- | Load an existing wallet from the given environment.
+    withWalletLoad
+        :: WalletEnv IO
+        -> (WalletInstance -> IO a)
+        -> IO a
+    withWalletLoad = undefined
+-}
+
+-- | Create a 'WalletResource'.
+withWalletResource
+    :: WalletIO.WalletEnv IO
+    -> (WalletResource -> IO b)
+    -> IO b
+withWalletResource _env = Resource.withResource
+
+-- | Error indicating that the 'WalletResource' does not hold a wallet.
+newtype ErrNoWallet
+    = ErrNoWallet Resource.ErrResourceMissing
+    deriving (Show)
+
+-- | Monad for acting on a 'WalletResource'.
+type WalletResourceM = ReaderT WalletResource (ExceptT ErrNoWallet IO)
+
+runWalletResourceM
+    :: WalletResourceM a
+    -> WalletResource
+    -> IO (Either ErrNoWallet a)
+runWalletResourceM action resource =
+    runExceptT (runReaderT action resource)
+
+-- | Run an 'IO' function on the 'WalletInstance'.
+onWalletInstance
+    :: (WalletIO.WalletInstance -> IO a)
+    -> WalletResourceM a
+onWalletInstance action = ReaderT $ \resource ->
+    ExceptT
+        $ first ErrNoWallet <$> Resource.onResource action resource
+
+-- | Error indicating that the 'WalletResource' already holds a wallet.
+data ErrWalletAlreadyExits
+    = ErrWalletAlreadyExitsOrVanished
+    deriving (Eq, Ord, Show)
+
+-- | Initialize a new wallet if none existed before.
+putWallet
+    :: WalletIO.WalletEnv IO
+    -> XPub
+    -> Word31
+    -> WalletResource
+    -> IO (Either ErrWalletAlreadyExits ())
+putWallet env xpub knownCustomerCount resource =
+    first (const ErrWalletAlreadyExitsOrVanished)
+        <$> Resource.putResource
+            (WalletIO.withWalletInit env xpub knownCustomerCount)
+            resource
+
+{-----------------------------------------------------------------------------
+    Operations
+------------------------------------------------------------------------------}
+listCustomers
+    :: WalletResourceM [(Customer, Address)]
+listCustomers = onWalletInstance WalletIO.listCustomers
+
+createAddress
+    :: Customer
+    -> WalletResourceM Address
+createAddress = onWalletInstance . WalletIO.createAddress
+
+{-----------------------------------------------------------------------------
+    Operations
+    Reading from the blockchain
+------------------------------------------------------------------------------}
+getWalletTip :: WalletResourceM Read.ChainPoint
+getWalletTip = onWalletInstance WalletIO.getWalletTip
+
+availableBalance :: WalletResourceM Read.Value
+availableBalance = onWalletInstance WalletIO.availableBalance
+
+getCustomerHistory
+    :: Customer
+    -> WalletResourceM [Wallet.TxSummary]
+getCustomerHistory = onWalletInstance . WalletIO.getCustomerHistory
+
+getCustomerHistories
+    :: (Read.ChainPoint, Read.ChainPoint)
+    -> WalletResourceM (Map.Map Customer Wallet.ValueTransfer)
+getCustomerHistories = onWalletInstance . WalletIO.getCustomerHistories
+
+{-----------------------------------------------------------------------------
+    Operations
+    Writing to blockchain
+------------------------------------------------------------------------------}
+
+createPayment
+    :: [(Address, Read.Value)]
+    -> WalletResourceM (Maybe Write.TxBody)
+createPayment = onWalletInstance . WalletIO.createPayment
+
+getBIP32PathsForOwnedInputs
+    :: Write.TxBody
+    -> WalletResourceM [BIP32Path]
+getBIP32PathsForOwnedInputs =
+    onWalletInstance . WalletIO.getBIP32PathsForOwnedInputs
+
+signTxBody
+    :: Write.TxBody
+    -> WalletResourceM (Maybe Write.Tx)
+signTxBody = onWalletInstance . WalletIO.signTxBody