{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}

module Utxorpc.Server
  ( runUtxorpc,
    ServiceConfig (..),
    UtxorpcHandlers (..),
    BuildHandlers (..),
    SubmitHandlers (..),
    SyncHandlers (..),
    WatchHandlers (..),
    UtxorpcServiceLogger (..),
    RequestLogger,
    ReplyLogger,
    ServerStreamLogger,
    ServerStreamEndLogger,
  )
where

import Control.Monad.IO.Class (MonadIO)
import Network.GRPC.HTTP2.Encoding (Compression)
import Network.GRPC.Server
import Network.Wai.Handler.Warp (Settings)
import Network.Wai.Handler.WarpTLS (TLSSettings)
import Utxorpc.Build as Build (BuildHandlers (..), serviceHandlers)
import Utxorpc.Logged (ReplyLogger, RequestLogger, ServerStreamEndLogger, ServerStreamLogger, UtxorpcServiceLogger (..))
import Utxorpc.Submit as Submit (SubmitHandlers (..), serviceHandlers)
import Utxorpc.Sync as Sync (SyncHandlers (..), serviceHandlers)
import Utxorpc.Watch as Watch (WatchHandlers (..), serviceHandlers)

-- | Run a UTxO RPC service from a @'ServiceConfig'@.
runUtxorpc ::
  (MonadIO m) =>
  -- | Configuration info and method handlers. See @'ServiceConfig'@ for type information.
  ServiceConfig m a b c d e ->
  IO ()
runUtxorpc :: forall (m :: * -> *) a b c d e.
MonadIO m =>
ServiceConfig m a b c d e -> IO ()
runUtxorpc
  ServiceConfig
    { TLSSettings
tlsSettings :: TLSSettings
tlsSettings :: forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> TLSSettings
tlsSettings,
      Settings
warpSettings :: Settings
warpSettings :: forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> Settings
warpSettings,
      UtxorpcHandlers m a b c d e
handlers :: UtxorpcHandlers m a b c d e
handlers :: forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> UtxorpcHandlers m a b c d e
handlers,
      Maybe (UtxorpcServiceLogger m)
logger :: Maybe (UtxorpcServiceLogger m)
logger :: forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> Maybe (UtxorpcServiceLogger m)
logger,
      forall x. m x -> IO x
unlift :: forall x. m x -> IO x
unlift :: forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> forall x. m x -> IO x
unlift,
      [Compression]
compression :: [Compression]
compression :: forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> [Compression]
compression
    } =
    TLSSettings
-> Settings -> [ServiceHandler] -> [Compression] -> IO ()
runGrpc
      TLSSettings
tlsSettings
      Settings
warpSettings
      (Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x)
-> UtxorpcHandlers m a b c d e
-> [ServiceHandler]
forall (m :: * -> *) a b c d e.
MonadIO m =>
Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x)
-> UtxorpcHandlers m a b c d e
-> [ServiceHandler]
Utxorpc.Server.serviceHandlers Maybe (UtxorpcServiceLogger m)
logger m x -> IO x
forall x. m x -> IO x
unlift UtxorpcHandlers m a b c d e
handlers)
      [Compression]
compression

-- | Configuration info and method handlers.
-- Note that the handlers and logger run in the same monad.
-- The monadic actions of the logger and handlers for a single call are combined,
-- and @'unlift'@ runs the combined action in IO. This means that changes to the
-- monadic state made by the request logger (e.g., adding a namespace) are seen by
-- the handlers and other logging functions for that specific call.
data ServiceConfig m a b c d e = ServiceConfig
  { -- | warp-tls settings for using TLS.
    forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> TLSSettings
tlsSettings :: TLSSettings,
    -- | warp settings
    forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> Settings
warpSettings :: Settings,
    -- | A handler for each method in the UTxO RPC specification.
    forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> UtxorpcHandlers m a b c d e
handlers :: UtxorpcHandlers m a b c d e,
    -- | Log each RPC event.
    forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> Maybe (UtxorpcServiceLogger m)
logger :: Maybe (UtxorpcServiceLogger m),
    -- | An unlift function for the handlers and logger. Allows the handler and logger to be run in any monad, but they must be the same monad.
    forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> forall x. m x -> IO x
unlift :: forall x. m x -> IO x,
    -- | A list of compressions to accept and use.
    forall (m :: * -> *) a b c d e.
ServiceConfig m a b c d e -> [Compression]
compression :: [Compression]
  }

-- | A handler for each method in the UTxO RPC specification.
-- @'ServerStreamHandler'@s require a type variable representing the "stream state" (a value that the stream processes/folds over).
-- The type variables here (other than @`m`@) are the type variables of each stream handler in the record.
data
  UtxorpcHandlers
    m -- Monad of the handler functions
    a -- Stream state of `holdUtxo`
    b -- Stream state of `waitForTx`
    c -- Stream state of `watchMempool`
    d -- Stream state of `followTip`
    e -- Stream state of `watchTx`
  = UtxorpcHandlers
  { -- | Handlers for the Build module.
    forall (m :: * -> *) a b c d e.
UtxorpcHandlers m a b c d e -> BuildHandlers m a
buildHandlers :: BuildHandlers m a,
    -- | Handlers for the Submit module.
    forall (m :: * -> *) a b c d e.
UtxorpcHandlers m a b c d e -> SubmitHandlers m b c
submitHandlers :: SubmitHandlers m b c,
    -- | Handlers for the Sync module.
    forall (m :: * -> *) a b c d e.
UtxorpcHandlers m a b c d e -> SyncHandlers m d
syncHandlers :: SyncHandlers m d,
    -- | Handlers for the Watch module.
    forall (m :: * -> *) a b c d e.
UtxorpcHandlers m a b c d e -> WatchHandlers m e
watchHandlers :: WatchHandlers m e
  }

serviceHandlers ::
  (MonadIO m) =>
  Maybe (UtxorpcServiceLogger m) ->
  (forall x. m x -> IO x) ->
  UtxorpcHandlers m a b c d e ->
  [ServiceHandler]
serviceHandlers :: forall (m :: * -> *) a b c d e.
MonadIO m =>
Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x)
-> UtxorpcHandlers m a b c d e
-> [ServiceHandler]
serviceHandlers
  Maybe (UtxorpcServiceLogger m)
logger
  forall x. m x -> IO x
unlift
  UtxorpcHandlers {BuildHandlers m a
buildHandlers :: forall (m :: * -> *) a b c d e.
UtxorpcHandlers m a b c d e -> BuildHandlers m a
buildHandlers :: BuildHandlers m a
buildHandlers, SubmitHandlers m b c
submitHandlers :: forall (m :: * -> *) a b c d e.
UtxorpcHandlers m a b c d e -> SubmitHandlers m b c
submitHandlers :: SubmitHandlers m b c
submitHandlers, SyncHandlers m d
syncHandlers :: forall (m :: * -> *) a b c d e.
UtxorpcHandlers m a b c d e -> SyncHandlers m d
syncHandlers :: SyncHandlers m d
syncHandlers, WatchHandlers m e
watchHandlers :: forall (m :: * -> *) a b c d e.
UtxorpcHandlers m a b c d e -> WatchHandlers m e
watchHandlers :: WatchHandlers m e
watchHandlers} =
    Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x) -> BuildHandlers m a -> [ServiceHandler]
forall (m :: * -> *) b.
MonadIO m =>
Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x) -> BuildHandlers m b -> [ServiceHandler]
Build.serviceHandlers Maybe (UtxorpcServiceLogger m)
logger m x -> IO x
forall x. m x -> IO x
unlift BuildHandlers m a
buildHandlers
      [ServiceHandler] -> [ServiceHandler] -> [ServiceHandler]
forall a. Semigroup a => a -> a -> a
<> Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x)
-> SubmitHandlers m b c
-> [ServiceHandler]
forall (m :: * -> *) b c.
MonadIO m =>
Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x)
-> SubmitHandlers m b c
-> [ServiceHandler]
Submit.serviceHandlers Maybe (UtxorpcServiceLogger m)
logger m x -> IO x
forall x. m x -> IO x
unlift SubmitHandlers m b c
submitHandlers
      [ServiceHandler] -> [ServiceHandler] -> [ServiceHandler]
forall a. Semigroup a => a -> a -> a
<> Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x) -> SyncHandlers m d -> [ServiceHandler]
forall (m :: * -> *) b.
MonadIO m =>
Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x) -> SyncHandlers m b -> [ServiceHandler]
Sync.serviceHandlers Maybe (UtxorpcServiceLogger m)
logger m x -> IO x
forall x. m x -> IO x
unlift SyncHandlers m d
syncHandlers
      [ServiceHandler] -> [ServiceHandler] -> [ServiceHandler]
forall a. Semigroup a => a -> a -> a
<> Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x) -> WatchHandlers m e -> [ServiceHandler]
forall (m :: * -> *) b.
MonadIO m =>
Maybe (UtxorpcServiceLogger m)
-> (forall x. m x -> IO x) -> WatchHandlers m b -> [ServiceHandler]
Watch.serviceHandlers Maybe (UtxorpcServiceLogger m)
logger m x -> IO x
forall x. m x -> IO x
unlift WatchHandlers m e
watchHandlers