Skip to content
Permalink
Browse files

Add 'utxo-at' route

  • Loading branch information
j-mueller committed Feb 14, 2020
1 parent f622c0a commit bac722daa9dcc7c33da12b4fec65dfc2e2e46d67
@@ -5,11 +5,18 @@ module Cardano.Node.API
( API
) where

import Ledger (Slot, Tx)
import Data.Map (Map)

import Ledger (Address, Slot, Tx, TxOutRef, TxOut)
import Servant.API ((:<|>), (:>), Get, JSON, NoContent, Post, ReqBody)

type API
= "healthcheck" :> Get '[ JSON] NoContent
:<|> "mempool" :> ReqBody '[ JSON] Tx :> Post '[ JSON] NoContent
:<|> "slot" :> Get '[ JSON] Slot
:<|> "random-tx" :> Get '[ JSON] Tx
:<|> "mock" :> MockAPI

-- Routes that are not guaranteed to exist on the real node
type MockAPI =
"random-tx" :> Get '[ JSON] Tx
:<|> "utxo-at" :> ReqBody '[ JSON] Address :> Post '[ JSON] (Map TxOutRef TxOut)
@@ -3,8 +3,9 @@
module Cardano.Node.Client where

import Cardano.Node.API (API)
import Data.Map (Map)
import Data.Proxy (Proxy (Proxy))
import Ledger (Slot, Tx)
import Ledger (Address, Slot, Tx, TxOutRef, TxOut)
import Network.HTTP.Client (defaultManagerSettings, newManager)
import Servant ((:<|>) (..), NoContent)
import Servant.Client (ClientM, client, mkClientEnv, parseBaseUrl, runClientM)
@@ -13,10 +14,11 @@ healthcheck :: ClientM NoContent
getCurrentSlot :: ClientM Slot
addTx :: Tx -> ClientM NoContent
randomTx :: ClientM Tx
(healthcheck, addTx, getCurrentSlot, randomTx) =
(healthcheck_, addTx_, getCurrentSlot_, randomTx_)
utxoAt :: Address -> ClientM (Map TxOutRef TxOut)
(healthcheck, addTx, getCurrentSlot, randomTx, utxoAt) =
(healthcheck_, addTx_, getCurrentSlot_, randomTx_, utxoAt_)
where
healthcheck_ :<|> addTx_ :<|> getCurrentSlot_ :<|> randomTx_ =
healthcheck_ :<|> addTx_ :<|> getCurrentSlot_ :<|> (randomTx_ :<|> utxoAt_) =
client (Proxy @API)

main :: IO ()
@@ -26,6 +26,7 @@ import qualified Control.Monad.Freer.Writer as Eff
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Logger (MonadLogger, logDebugN, logInfoN, runStdoutLoggingT)
import Data.Foldable (traverse_)
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Proxy (Proxy (Proxy))
import Data.Text.Prettyprint.Doc (Pretty (pretty))
@@ -38,7 +39,7 @@ import Servant ((:<|>) ((:<|>)), Application, N
import Language.Plutus.Contract.Trace (InitialDistribution)
import qualified Language.Plutus.Contract.Trace as Trace

import Ledger (Slot, Tx)
import Ledger (Address, Slot, Tx, TxOut(..), TxOutRef, UtxoIndex (..))
import qualified Ledger

import Cardano.Node.RandomTx
@@ -103,6 +104,11 @@ addBlock = do
simpleLogInfo "Adding slot"
void Chain.processBlock

utxoAt :: (Member (State ChainState) effs) => Address -> Eff effs (Map TxOutRef TxOut)
utxoAt addr = do
UtxoIndex idx <- Eff.gets (view EM.index)
pure $ Map.filter (\TxOut{txOutAddress} -> txOutAddress == addr) idx

addTx :: (Member SimpleLog effs, Member ChainEffect effs) => Tx -> Eff effs NoContent
addTx tx = do
simpleLogInfo $ "Adding tx " <> tshow (Ledger.txId tx)
@@ -192,7 +198,7 @@ app stateVar =
(healthcheck
:<|> addTx
:<|> getCurrentSlot
:<|> genRandomTx)
:<|> (genRandomTx :<|> utxoAt))

main :: (MonadIO m, MonadLogger m) => MockServerConfig -> m ()
main config = do

0 comments on commit bac722d

Please sign in to comment.
You can’t perform that action at this time.