{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RankNTypes #-}

-- |
-- Module       : Utxorpc.Types
-- Description  : Record types and type aliases.
-- The types in this module are required to call methods of a `UtxorpcClient`.
module Utxorpc.Types
  ( UtxorpcClient (..),
    BuildClientImpl (..),
    SubmitClientImpl (..),
    SyncClientImpl (..),
    WatchClientImpl (..),
    ServerStreamCall,
    ServerStreamReply,
    UnaryReply,
  )
where

import Network.GRPC.Client (HeaderList, RawReply)
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 "http2-client" Network.HTTP2.Client (ClientError, TooMuchConcurrency)

-- | Type definition for functions that make calls to server stream methods.
-- Note that the stream state, a, can be different for each call.
type ServerStreamCall i o =
  forall a.
  -- | The initial state for the stream processing function.
  a ->
  -- | The request message to send to the service.
  i ->
  -- | The stream processing function. It is a fold over some state a with stream messages o.
  (a -> HeaderList -> o -> IO a) ->
  -- | The final state of the stream processing function, or an error.
  ServerStreamReply a

-- | The type returned by calls to unary service methods.
type UnaryReply o =
  IO
    (Either ClientError (Either TooMuchConcurrency (RawReply o)))

-- | The type returned by calls to server stream methods. a is the final state of the stream processing function.
type ServerStreamReply a =
  IO
    (Either ClientError (Either TooMuchConcurrency (a, HeaderList, HeaderList)))

{---------------------------------------
  UtxorpcClient
---------------------------------------}

-- | Methods for each module in UTxO RPC.
-- >>> fetchBlock (buildClient client) defMessage
data UtxorpcClient = UtxorpcClient
  { -- | Build module service methods.
    UtxorpcClient -> BuildClientImpl
buildClient :: BuildClientImpl,
    -- | Submit module service methods.
    UtxorpcClient -> SubmitClientImpl
submitClient :: SubmitClientImpl,
    -- | Sync module service methods.
    UtxorpcClient -> SyncClientImpl
syncClient :: SyncClientImpl,
    -- | Watch module service methods.
    UtxorpcClient -> WatchClientImpl
watchClient :: WatchClientImpl,
    -- | Closes the gRPC connection.
    UtxorpcClient -> IO (Either ClientError ())
close :: IO (Either ClientError ())
  }

{---------------------------------------
  Build
---------------------------------------}

-- | Methods of the Build module
data BuildClientImpl = BuildClientImpl
  { BuildClientImpl
-> GetChainTipRequest -> UnaryReply GetChainTipResponse
getChainTip :: GetChainTipRequest -> UnaryReply GetChainTipResponse,
    BuildClientImpl
-> GetChainParamRequest -> UnaryReply GetChainParamResponse
getChainParam :: GetChainParamRequest -> UnaryReply GetChainParamResponse,
    BuildClientImpl
-> GetUtxoByAddressRequest -> UnaryReply GetUtxoByAddressResponse
getUtxoByAddress :: GetUtxoByAddressRequest -> UnaryReply GetUtxoByAddressResponse,
    BuildClientImpl
-> GetUtxoByRefRequest -> UnaryReply GetUtxoByRefResponse
getUtxoByRef :: GetUtxoByRefRequest -> UnaryReply GetUtxoByRefResponse,
    BuildClientImpl
-> ServerStreamCall HoldUtxoRequest HoldUtxoResponse
holdUtxo :: ServerStreamCall HoldUtxoRequest HoldUtxoResponse
  }

{---------------------------------------
  Submit
---------------------------------------}

-- | Methods of the Submit module
data SubmitClientImpl = SubmitClientImpl
  { SubmitClientImpl -> SubmitTxRequest -> UnaryReply SubmitTxResponse
submitTx :: SubmitTxRequest -> UnaryReply SubmitTxResponse,
    SubmitClientImpl
-> ReadMempoolRequest -> UnaryReply ReadMempoolResponse
readMempool :: ReadMempoolRequest -> UnaryReply ReadMempoolResponse,
    SubmitClientImpl
-> ServerStreamCall WaitForTxRequest WaitForTxResponse
waitForTx :: ServerStreamCall WaitForTxRequest WaitForTxResponse,
    SubmitClientImpl
-> ServerStreamCall WatchMempoolRequest WatchMempoolResponse
watchMempool :: ServerStreamCall WatchMempoolRequest WatchMempoolResponse
  }

{---------------------------------------
  Sync
---------------------------------------}

-- | Methods of the Sync module
data SyncClientImpl = SyncClientImpl
  { SyncClientImpl
-> FetchBlockRequest -> UnaryReply FetchBlockResponse
fetchBlock :: FetchBlockRequest -> UnaryReply FetchBlockResponse,
    SyncClientImpl
-> DumpHistoryRequest -> UnaryReply DumpHistoryResponse
dumpHistory :: DumpHistoryRequest -> UnaryReply DumpHistoryResponse,
    SyncClientImpl
-> ServerStreamCall FollowTipRequest FollowTipResponse
followTip :: ServerStreamCall FollowTipRequest FollowTipResponse
  }

{---------------------------------------
  Watch
---------------------------------------}

-- | Methods of the watch module
newtype WatchClientImpl = WatchClientImpl
  { WatchClientImpl -> ServerStreamCall WatchTxRequest WatchTxResponse
watchTx :: ServerStreamCall WatchTxRequest WatchTxResponse
  }