View on GitHub
File Changes

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

                      
-- | Note: This API uses the wholly-fictitious notion of an "active" wallet.
     = "wallets" :> (Get '[ JSON] [Wallet]
                     :<|> "active" :> ("pubkey" :> Get '[ JSON] PubKey
                                       :<|> "sign" :> ReqBody '[ JSON] BSL.ByteString :> Post '[ JSON] Signature
-
                                       :<|> "watched-addresses" :> Get '[ JSON] AddressMap)
+
                                       :<|> "watched-addresses" :> Get '[ JSON] AddressMap
+
                                       :<|> "start-watching" :> ReqBody '[ JSON] Address :> Post '[ JSON] NoContent)
                     :<|> (Capture "walletId" WalletId :> ("coin-selections" :> "random" :> ReqBody '[ JSON] Value :> Get '[ JSON] ( [Value]
                                                                                                                                   , Value)
                                                           :<|> "addresses" :> "new" :> Post '[ JSON] PubKey)))
import qualified Data.ByteString.Lazy   as BSL
import           Data.Function          ((&))
import           Data.Proxy             (Proxy (Proxy))
-
import           Ledger                 (PubKey, Signature, Value)
+
import           Ledger                 (Address, PubKey, Signature, Value)
import           Ledger.AddressMap      (AddressMap)
import           Network.HTTP.Client    (defaultManagerSettings, newManager)
+
import           Servant                (NoContent)
import           Servant.Client         (ClientM, client, mkClientEnv, parseBaseUrl, runClientM)
import           Servant.Extra          (left, right)
import           Wallet.Emulator.Wallet (Wallet)
getWatchedAddresses :: ClientM AddressMap
getWallets :: ClientM [Wallet]
getOwnPubKey :: ClientM PubKey
+
startWatching :: Address -> ClientM NoContent
sign :: BSL.ByteString -> ClientM Signature
-
(getWallets, getOwnPubKey, sign, getWatchedAddresses, selectCoins, allocateAddress) =
+
(getWallets, getOwnPubKey, sign, getWatchedAddresses, startWatching, selectCoins, allocateAddress) =
    ( getWallets_
    , getOwnPubKey_
    , sign_
    , getWatchedAddresses_
+
    , startWatching_
    , selectCoins_
    , allocateAddress_)
  where
    active_ = api & right & left
    getOwnPubKey_ = active_ & left
    sign_ = active_ & right & left
-
    getWatchedAddresses_ = active_ & right & right
+
    getWatchedAddresses_ = active_ & right & right & left
+
    startWatching_ = active_ & right & right & right
    byWalletId = api & right & right
    selectCoins_ walletId = byWalletId walletId & left
    allocateAddress_ walletId = byWalletId walletId & right
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
+
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeOperators     #-}

                      

                      
import           Cardano.Wallet.API          (API)
import           Cardano.Wallet.Types        (WalletId)
-
import           Control.Concurrent.STM.TVar (TVar, newTVarIO, readTVarIO)
+
import           Control.Concurrent.STM      (atomically)
+
import           Control.Concurrent.STM.TVar (TVar, modifyTVar, newTVarIO, readTVarIO)
+
import           Control.Lens                (makeLenses, over)
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           Ledger                      (Address, PubKey, Signature, Value)
+
import           Ledger.AddressMap           (AddressMap, addAddress)
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                     ((:<|>) ((:<|>)), Application, Handler (Handler), NoContent (NoContent),
+
                                              ServantErr, hoistServer, serve)
import           Servant.Extra               (capture)
import           Test.QuickCheck             (arbitrary, generate)
import           Wallet.Emulator.Wallet      (Wallet (Wallet))
        }
    deriving (Show, Eq)

                      
+
makeLenses 'State
+

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

                      
    State {_watchedAddresses} <- liftIO $ readTVarIO tvarState
    pure _watchedAddresses

                      
+
startWatching ::
+
       (MonadIO m, MonadReader (TVar State) m) => Address -> m NoContent
+
startWatching address = do
+
    tvarState <- ask
+
    liftIO $
+
        atomically $
+
        modifyTVar tvarState (over watchedAddresses (addAddress address))
+
    pure NoContent
+

                      
sign :: Monad m => BSL.ByteString -> m Signature
sign bs = do
    let privK = EM.walletPrivKey activeWallet
app tvarState =
    serve (Proxy @API) $
    hoistServer (Proxy @API) (asHandler tvarState) $
-
    wallets :<|> (getOwnPubKey :<|> sign :<|> getWatchedAddresses) :<|>
+
    wallets :<|>
+
    (getOwnPubKey :<|> sign :<|> getWatchedAddresses :<|> startWatching) :<|>
    capture (selectCoin :<|> allocateAddress)

                      
main :: (MonadIO m, MonadLogger m) => m ()
    sign bs = runWalletClientM $ WalletClient.sign bs
    updatePaymentWithChange _ _ = error "UNIMPLEMENTED: updatePaymentWithChange"
    watchedAddresses = runWalletClientM WalletClient.getWatchedAddresses
-
    startWatching _ = error "UNIMPLEMENTED: startWatching"
+
    startWatching = void . runWalletClientM . WalletClient.startWatching

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

                      
runApp :: DbConfig -> App a -> IO (Either SCBError a)
runApp dbConfig (App action) =
-
    runStdoutLoggingT . filterLogger (\_ level -> level >= LevelDebug) $ do
+
    runStdoutLoggingT . filterLogger (\_ level -> level > LevelDebug) $ do
        walletManager <- liftIO $ newManager defaultManagerSettings
        walletBaseUrl <- parseBaseUrl "http://localhost:8081"
        let walletClientEnv = mkClientEnv walletManager walletBaseUrl