View on GitHub
File Changes
import           Cardano.Wallet.Types   (WalletId)
import qualified Data.ByteString.Lazy   as BSL
import           Ledger                 (PubKey, Signature, Value)
+
import           Ledger.AddressMap      (AddressMap)
import           Servant.API            ((:<|>), (:>), Capture, Get, JSON, Post, ReqBody)
import           Wallet.Emulator.Wallet (Wallet)

                      
type API
     = "wallets" :> (Get '[ JSON] [Wallet]
                     :<|> "active" :> ("pubkey" :> Get '[ JSON] PubKey
-
                                       :<|> "sign" :> ReqBody '[ JSON] BSL.ByteString :> Post '[ JSON] Signature)
+
                                       :<|> "sign" :> ReqBody '[ JSON] BSL.ByteString :> Post '[ JSON] Signature
+
                                       :<|> "watched-addresses" :> Get '[ JSON] AddressMap)
                     :<|> (Capture "walletId" WalletId :> ("coin-selections" :> "random" :> ReqBody '[ JSON] Value :> Get '[ JSON] ( [Value]
                                                                                                                                   , Value)
                                                           :<|> "addresses" :> "new" :> Post '[ JSON] PubKey)))
import           Data.Function          ((&))
import           Data.Proxy             (Proxy (Proxy))
import           Ledger                 (PubKey, Signature, Value)
+
import           Ledger.AddressMap      (AddressMap)
import           Network.HTTP.Client    (defaultManagerSettings, newManager)
import           Servant.Client         (ClientM, client, mkClientEnv, parseBaseUrl, runClientM)
import           Servant.Extra          (left, right)
import           Wallet.Emulator.Wallet (Wallet)

                      
selectCoins :: WalletId -> Value -> ClientM ([Value], Value)
allocateAddress :: WalletId -> ClientM PubKey
+
getWatchedAddresses :: ClientM AddressMap
getWallets :: ClientM [Wallet]
getOwnPubKey :: ClientM PubKey
sign :: BSL.ByteString -> ClientM Signature
-
(getWallets, getOwnPubKey, sign, selectCoins, allocateAddress) =
-
    (getWallets_, getOwnPubKey_, sign_, selectCoins_, allocateAddress_)
+
(getWallets, getOwnPubKey, sign, getWatchedAddresses, selectCoins, allocateAddress) =
+
    ( getWallets_
+
    , getOwnPubKey_
+
    , sign_
+
    , getWatchedAddresses_
+
    , selectCoins_
+
    , allocateAddress_)
  where
    api = client (Proxy @API)
-
    getWallets_ = left api
-
    active_ = right api & left
-
    getOwnPubKey_ = left active_
-
    sign_ = right active_
-
    byWalletId =  right api & right
+
    getWallets_ = api & left
+
    active_ = api & right & left
+
    getOwnPubKey_ = active_ & left
+
    sign_ = active_ & right & left
+
    getWatchedAddresses_ = active_ & right & right
+
    byWalletId = api & right & right
    selectCoins_ walletId = byWalletId walletId & left
    allocateAddress_ walletId = byWalletId walletId & right

                      
+
{-# LANGUAGE FlexibleContexts  #-}
+
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeOperators     #-}
    ( main
    ) where

                      
-
import           Cardano.Wallet.API       (API)
-
import           Cardano.Wallet.Types     (WalletId)
-
import           Control.Monad.Except     (ExceptT)
-
import           Control.Monad.IO.Class   (MonadIO, liftIO)
-
import           Control.Monad.Logger     (MonadLogger, logInfoN)
-
import qualified Data.ByteString.Lazy     as BSL
-
import           Data.Proxy               (Proxy (Proxy))
-
import           Ledger                   (PubKey, Signature, Value)
-
import qualified Ledger.Crypto            as Crypto
-
import           Network.Wai.Handler.Warp (run)
-
import           Plutus.SCB.Arbitrary     ()
-
import           Plutus.SCB.Utils         (tshow)
-
import           Servant                  ((:<|>) ((:<|>)), Application, Handler (Handler), ServantErr, hoistServer,
-
                                           serve)
-
import           Servant.Extra            (capture)
-
import           Test.QuickCheck          (arbitrary, generate)
-
import           Wallet.Emulator.Wallet   (Wallet (Wallet))
-
import qualified Wallet.Emulator.Wallet   as EM
+
import           Cardano.Wallet.API          (API)
+
import           Cardano.Wallet.Types        (WalletId)
+
import           Control.Concurrent.STM.TVar (TVar, newTVarIO, readTVarIO)
+
import           Control.Monad.Except        (ExceptT)
+
import           Control.Monad.IO.Class      (MonadIO, liftIO)
+
import           Control.Monad.Logger        (MonadLogger, logInfoN)
+
import           Control.Monad.Reader        (MonadReader, ReaderT, ask, runReaderT)
+
import qualified Data.ByteString.Lazy        as BSL
+
import           Data.Proxy                  (Proxy (Proxy))
+
import           Ledger                      (PubKey, Signature, Value)
+
import           Ledger.AddressMap           (AddressMap)
+
import qualified Ledger.Crypto               as Crypto
+
import           Network.Wai.Handler.Warp    (run)
+
import           Plutus.SCB.Arbitrary        ()
+
import           Plutus.SCB.Utils            (tshow)
+
import           Servant                     ((:<|>) ((:<|>)), Application, Handler (Handler), ServantErr, hoistServer,
+
                                              serve)
+
import           Servant.Extra               (capture)
+
import           Test.QuickCheck             (arbitrary, generate)
+
import           Wallet.Emulator.Wallet      (Wallet (Wallet))
+
import qualified Wallet.Emulator.Wallet      as EM
+

                      
+
newtype State =
+
    State
+
        { _watchedAddresses :: AddressMap
+
        }
+
    deriving (Show, Eq)
+

                      
+
initialState :: State
+
initialState = State {_watchedAddresses = mempty}

                      
wallets :: Monad m => m [Wallet]
wallets = pure $ Wallet <$> [1 .. 10]
activeWallet :: Wallet
activeWallet = Wallet 1

                      
+
getWatchedAddresses :: (MonadIO m, MonadReader (TVar State) m) => m AddressMap
+
getWatchedAddresses = do
+
    tvarState <- ask
+
    State {_watchedAddresses} <- liftIO $ readTVarIO tvarState
+
    pure _watchedAddresses
+

                      
sign :: Monad m => BSL.ByteString -> m Signature
sign bs = do
    let privK = EM.walletPrivKey activeWallet
    pure (Crypto.sign (BSL.toStrict bs) privK)

                      
------------------------------------------------------------
-
asHandler :: ExceptT ServantErr IO a -> Handler a
-
asHandler = Handler
+
asHandler ::
+
       TVar State -> ReaderT (TVar State) (ExceptT ServantErr IO) a -> Handler a
+
asHandler tvarState action = Handler (runReaderT action tvarState)

                      
-
app :: Application
-
app =
+
app :: TVar State -> Application
+
app tvarState =
    serve (Proxy @API) $
-
    hoistServer (Proxy @API) asHandler $
-
    wallets :<|> (getOwnPubKey :<|> sign) :<|>
+
    hoistServer (Proxy @API) (asHandler tvarState) $
+
    wallets :<|> (getOwnPubKey :<|> sign :<|> getWatchedAddresses) :<|>
    capture (selectCoin :<|> allocateAddress)

                      
main :: (MonadIO m, MonadLogger m) => m ()
main = do
    let port = 8081
    logInfoN $ "Starting mock wallet server on port: " <> tshow port
-
    liftIO $ run port app
+
    tvarState <- liftIO $ newTVarIO initialState
+
    liftIO $ run port $ app tvarState
instance WalletAPI App where
    ownPubKey = runWalletClientM WalletClient.getOwnPubKey
    sign bs = runWalletClientM $ WalletClient.sign bs
-
    updatePaymentWithChange _ _ = undefined
-
    watchedAddresses = pure mempty
-
    startWatching _ = pure ()
+
    updatePaymentWithChange _ _ = error "UNIMPLEMENTED: updatePaymentWithChange"
+
    watchedAddresses = runWalletClientM WalletClient.getWatchedAddresses
+
    startWatching _ = error "UNIMPLEMENTED: startWatching"

                      
runAppClientM ::
       (Env -> ClientEnv) -> (ServantError -> SCBError) -> ClientM a -> App a