diff --git a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal b/lib/customer-deposit-wallet/customer-deposit-wallet.cabal index 087dc35b32c..ce3022f3713 100644 --- a/lib/customer-deposit-wallet/customer-deposit-wallet.cabal +++ b/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 diff --git a/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/REST.hs b/lib/customer-deposit-wallet/src/Cardano/Wallet/Deposit/REST.hs new file mode 100644 index 00000000000..349fcc95fe7 --- /dev/null +++ b/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