Client.hs

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module        : Utxorpc.Client
-- Description   : Create a connected UTxO RPC client.
-- Create a UTxO RPC client connected to a UTxO RPC service. The @'UtxorpcClient'@ provides functions for each of the methods in the UTxO RPC specification.
-- Provide a UtxorpcClientLogger to perform automated logging.
module Utxorpc.Client
  ( UtxorpcInfo (..),
    utxorpcClient,
    simpleUtxorpcClient,
    utxorpcClientWith,
    UtxorpcClientLogger (..),
    RequestLogger,
    ReplyLogger,
    ServerStreamLogger,
    ServerStreamEndLogger,
  )
where

import qualified Data.ByteString.Char8 as BS
import Network.GRPC.Client (gzip, uncompressed)
import Network.GRPC.Client.Helpers
  ( GrpcClient (_grpcClientHeaders),
    GrpcClientConfig,
    UseTlsOrNot,
    close,
    grpcClientConfigSimple,
    setupGrpcClient,
    _grpcClientConfigCompression,
  )
import Network.GRPC.HTTP2.ProtoLens (RPC (RPC))
import Proto.Utxorpc.V1alpha.Build.Build
import Proto.Utxorpc.V1alpha.Submit.Submit
import Proto.Utxorpc.V1alpha.Sync.Sync
import Proto.Utxorpc.V1alpha.Watch.Watch
import Utxorpc.Logged (ReplyLogger, RequestLogger, ServerStreamEndLogger, ServerStreamLogger, UtxorpcClientLogger (..), loggedSStream, loggedUnary)
import Utxorpc.Types
import "http2-client" Network.HTTP2.Client (ClientError, HostName, PortNumber, runClientIO)

-- | Configuration info for a UTxO RPC Client.
-- For more fine-grained control, use @'GrpcClientConfig'@ and @'UtxorpcClientWith'@
data UtxorpcInfo m = UtxorpcInfo
  { -- | Host name of the service.
    _hostName :: HostName,
    -- | Port number of the service.
    _portNumber :: PortNumber,
    -- | Whether or not to use TLS.
    _tlsEnabled :: UseTlsOrNot,
    -- | Whether or not to use gzip compression.
    _useGzip :: Bool,
    -- | Headers to include in each request (e.g., API key/authorization).
    _clientHeaders :: [(BS.ByteString, BS.ByteString)],
    -- | Log all RPC events.
    _logger :: Maybe (UtxorpcClientLogger m)
  }

-- | Make a connection to a UTxO RPC service with the minimum required information.
-- No compression is used, no headers are added, and no logging is performed.
-- For more configurability, use @'utxorpcClient'@ or @'utxorpcClientWith'@.
simpleUtxorpcClient ::
  -- | Host name of the service.
  HostName ->
  -- | Port number of the service.
  PortNumber ->
  -- | Whether or not to use TLS.
  UseTlsOrNot ->
  IO (Either ClientError UtxorpcClient)
simpleUtxorpcClient host port tlsEnabled =
  utxorpcClient $
    UtxorpcInfo host port tlsEnabled False [] Nothing

-- | Connect to a UTxO RPC service from a @'UtxorpcInfo'@.
-- Provides more configurability than @'simpleUtxorpcClient'@ but less than @'utxorpcClientWith'@.
utxorpcClient :: UtxorpcInfo m -> IO (Either ClientError UtxorpcClient)
utxorpcClient
  UtxorpcInfo {_hostName, _portNumber, _tlsEnabled, _useGzip, _logger, _clientHeaders} = do
    eClient <- grpcClient _hostName _portNumber _tlsEnabled _useGzip
    return $ fromGrpc _logger . withHeaders _clientHeaders <$> eClient
    where
      withHeaders hdrs client =
        let oldHdrs = _grpcClientHeaders client
         in client {_grpcClientHeaders = oldHdrs ++ hdrs}

-- | Connect to a UTxO RPC from a @'GrpcClientConfig'@.
-- For a simpler interface with less configurability, use @'utxorpcClient'@ or @'simpleUtxorpcClient'@.
utxorpcClientWith ::
  GrpcClientConfig ->
  Maybe (UtxorpcClientLogger m) ->
  IO (Either ClientError UtxorpcClient)
utxorpcClientWith config logger = do
  eClient <- runClientIO $ setupGrpcClient config
  return $ fromGrpc logger <$> eClient

grpcClient ::
  HostName ->
  PortNumber ->
  UseTlsOrNot ->
  Bool ->
  IO (Either ClientError GrpcClient)
grpcClient host port tlsEnabled doCompress = runClientIO $ do
  setupGrpcClient
    ( (grpcClientConfigSimple host port tlsEnabled)
        { _grpcClientConfigCompression = compression
        }
    )
  where
    compression = if doCompress then gzip else uncompressed

fromGrpc :: Maybe (UtxorpcClientLogger m) -> GrpcClient -> UtxorpcClient
fromGrpc logger client =
  UtxorpcClient
    (buildClientImpl logger client)
    (submitClientImpl logger client)
    (syncClientImpl logger client)
    (watchClientImpl logger client)
    (runClientIO $ Network.GRPC.Client.Helpers.close client)

{--------------------------------------
  BUILD
--------------------------------------}

buildClientImpl :: Maybe (UtxorpcClientLogger m) -> GrpcClient -> BuildClientImpl
buildClientImpl logger client =
  BuildClientImpl
    (loggedUnary logger getChainTipRPC client)
    (loggedUnary logger getChainParamRPC client)
    (loggedUnary logger getUtxoByAddressRPC client)
    (loggedUnary logger getUtxoByRefRPC client)
    (loggedSStream logger holdUtxoRPC client)

getChainTipRPC :: RPC LedgerStateService "getChainTip"
getChainTipRPC = RPC

getChainParamRPC :: RPC LedgerStateService "getChainParam"
getChainParamRPC = RPC

getUtxoByAddressRPC :: RPC LedgerStateService "getUtxoByAddress"
getUtxoByAddressRPC = RPC

getUtxoByRefRPC :: RPC LedgerStateService "getUtxoByRef"
getUtxoByRefRPC = RPC

holdUtxoRPC :: RPC LedgerStateService "holdUtxo"
holdUtxoRPC = RPC

{--------------------------------------
  SUBMIT
--------------------------------------}

submitClientImpl :: Maybe (UtxorpcClientLogger m) -> GrpcClient -> SubmitClientImpl
submitClientImpl logger client =
  SubmitClientImpl
    (loggedUnary logger submitTxRPC client)
    (loggedUnary logger readMempoolRPC client)
    (loggedSStream logger waitForTxRPC client)
    (loggedSStream logger watchMempoolRPC client)

submitTxRPC :: RPC SubmitService "submitTx"
submitTxRPC = RPC

readMempoolRPC :: RPC SubmitService "readMempool"
readMempoolRPC = RPC

waitForTxRPC :: RPC SubmitService "waitForTx"
waitForTxRPC = RPC

watchMempoolRPC :: RPC SubmitService "watchMempool"
watchMempoolRPC = RPC

{--------------------------------------
  SYNC
--------------------------------------}

syncClientImpl :: Maybe (UtxorpcClientLogger m) -> GrpcClient -> SyncClientImpl
syncClientImpl logger client =
  SyncClientImpl
    (loggedUnary logger fetchBlockRPC client)
    (loggedUnary logger dumpHistoryRPC client)
    (loggedSStream logger followTipRPC client)

fetchBlockRPC :: RPC ChainSyncService "fetchBlock"
fetchBlockRPC = RPC

dumpHistoryRPC :: RPC ChainSyncService "dumpHistory"
dumpHistoryRPC = RPC

followTipRPC :: RPC ChainSyncService "followTip"
followTipRPC = RPC

{--------------------------------------
  WATCH
--------------------------------------}

watchClientImpl :: Maybe (UtxorpcClientLogger m) -> GrpcClient -> WatchClientImpl
watchClientImpl logger client =
  WatchClientImpl $ loggedSStream logger watchTxRPC client

watchTxRPC :: RPC WatchService "watchTx"
watchTxRPC = RPC