{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Convex.Wallet.API(
API,
getHealth,
getUTxOs,
startServer
) where
import Cardano.Api (CtxTx)
import Control.Concurrent.STM (TVar, atomically, readTVar)
import Control.Monad.IO.Class (MonadIO (..))
import Convex.Utxos (UtxoSet)
import Convex.Wallet.WalletState (WalletState, utxoSet)
import Data.Proxy (Proxy (..))
import qualified Network.Wai.Handler.Warp as Warp
import Servant.API (Description, Get, JSON,
NoContent (..), type (:>),
(:<|>) (..))
import Servant.Client (ClientEnv, client, runClientM)
import Servant.Client.Core.ClientError (ClientError)
import Servant.Server (Server, serve)
type API =
"healthcheck" :> Description "Is the server alive?" :> Get '[JSON] NoContent
:<|> "utxos" :> Get '[JSON] (UtxoSet CtxTx ())
getHealth :: ClientEnv -> IO (Either ClientError NoContent)
getHealth :: ClientEnv -> IO (Either ClientError NoContent)
getHealth ClientEnv
clientEnv = do
let ClientM NoContent
healthcheck :<|> ClientM (UtxoSet CtxTx ())
_ = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @API)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM NoContent
healthcheck ClientEnv
clientEnv
getUTxOs :: ClientEnv -> IO (Either ClientError (UtxoSet CtxTx ()))
getUTxOs :: ClientEnv -> IO (Either ClientError (UtxoSet CtxTx ()))
getUTxOs ClientEnv
clientEnv = do
let ClientM NoContent
_ :<|> ClientM (UtxoSet CtxTx ())
utxos = forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client (forall {k} (t :: k). Proxy t
Proxy @API)
forall a. ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM (UtxoSet CtxTx ())
utxos ClientEnv
clientEnv
server :: TVar WalletState -> Server API
server :: TVar WalletState -> Server API
server TVar WalletState
walletState = Handler NoContent
health forall a b. a -> b -> a :<|> b
:<|> Handler (UtxoSet CtxTx ())
utxo
where
health :: Handler NoContent
health = forall (f :: * -> *) a. Applicative f => a -> f a
pure NoContent
NoContent
utxo :: Handler (UtxoSet CtxTx ())
utxo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (WalletState -> UtxoSet CtxTx ()
utxoSet forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. STM a -> IO a
atomically (forall a. TVar a -> STM a
readTVar TVar WalletState
walletState))
startServer :: TVar WalletState -> Int -> IO ()
startServer :: TVar WalletState -> Int -> IO ()
startServer TVar WalletState
walletState Int
port =
let app :: Application
app = forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve (forall {k} (t :: k). Proxy t
Proxy @API) (TVar WalletState -> Server API
server TVar WalletState
walletState)
in Int -> Application -> IO ()
Warp.run Int
port Application
app