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

-- |
-- Module        : Utxorpc.Server
-- Description   : Run a UTxO RPC service.
-- Run UTxO RPC service from a set of method handlers.
-- Provide a @'UtxorpcServiceLogger'@ to perform automated logging.
module Utxorpc.Server
  ( -- * How to use this library
    -- $use

    -- ** Server Stream Methods
    -- $streaming

    -- ** Logging
    -- $logging

    -- * Running a service
    runUtxorpc,
    ServiceConfig (..),
    UtxorpcHandlers (..),
    BuildHandlers (..),
    SubmitHandlers (..),
    SyncHandlers (..),
    WatchHandlers (..),

    -- * Logging
    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.
  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

-- $use
-- To run a UTxO RPC service:
--
--     1. Create a `UtxorpcHandlers` record, containing a handler for each method in the specification.
--
--     2. Create a `ServiceConfig` record, containing server settings (e.g., TLS settings), the handlers, and (optionally), a logger.
--
--     3. Call `runUtxorpc` with the `ServiceConfig`.

-- $streaming
-- To implement a server stream method, provide a @'ServerStreamHandler'@.
-- Given request metadata and a record of the relevant Message instance,
-- a @'ServerStreamHanlder'@ produces an initial stream state and a streaming function,
-- which folds over the stream state.
-- The stream is closed when the streaming function produces a @'Nothing'@.

-- $logging
-- Automated logging is supported through the @'UtxorpcServiceLogger'@ type.
-- It is a record of one user-defined logging function for each of the following events:
--
-- 1. Request received.
-- 1. Unary reply sent.
--
-- 1. Server stream data sent.
--
-- 1. Server stream ended.
--
-- For more information, see @'ServiceConfig'@, @'UtxorpcServiceLogger'@,
-- and the [`example`](https://github.com/utxorpc/haskell-sdk/tree/main/server/example).

-- $example
-- [`/example`](https://github.com/utxorpc/haskell-sdk/tree/main/server/example) shows how to use the SDK by creating a u5c service with simple handlers that
-- execute a log function and return default (i.e., empty) replies. It demonstrates how to use the SDK
-- without dealing with implementation details of the handlers. It uses one of the following two loggers:
--
--     1. `/example/SimpleLogger.hs` is a simple logger implementation that prints human-readable output.
--
--     1. `/example/KatipLogger.hs` is a more involved logger that demonstrates how to use logging
--     functions that run in a transformer stack. Run the example with `--katip` to use this logger.
--
--         > stack run server-example -- --katip -p=443