content: -- | Server context
  --
  -- Intended for unqualified import.
  module Network.GRPC.Server.Context (
      -- * Context
      ServerContext(..)
    , newServerContext
      -- * Configuration
    , ServerParams(..)
    ) where
  
  import Control.Exception
  import System.IO
  
  import Network.GRPC.Common
  import Network.GRPC.Common.Compression qualified as Compr
  import Network.GRPC.Server.RequestHandler.API
  import Network.GRPC.Spec
  import Data.Text (Text)
  import Data.Text qualified as Text
  
  {-------------------------------------------------------------------------------
    Context
  
    TODO: <https://github.com/well-typed/grapesy/issues/130>
    The server context is more of a placeholder at the moment. The plan is to use
    it to keep things like server usage statistics etc.
  -------------------------------------------------------------------------------}
  
  data ServerContext = ServerContext {
        serverParams :: ServerParams
      }
  
  newServerContext :: ServerParams -> IO ServerContext
  newServerContext serverParams = do
      return ServerContext{
          serverParams
        }
  
  {-------------------------------------------------------------------------------
    Configuration
  -------------------------------------------------------------------------------}
  
  data ServerParams = ServerParams {
        -- | Server compression preferences
        serverCompression :: Compr.Negotation
  
        -- | Top-level hook for request handlers
        --
        -- The most important responsibility of this function is to deal with
        -- any exceptions that the handler might throw, but in principle it has
        -- full control over how requests are handled.
        --
        -- The default merely logs any exceptions to 'stderr'.
      , serverTopLevel :: RequestHandler () -> RequestHandler ()
  
        -- | Render handler-side exceptions for the client
        --
        -- When a handler throws an exception other than a 'GrpcException', we use
        -- this function to render that exception for the client (server-side
        -- logging is taken care of by 'serverTopLevel'). The default
        -- implementation simply calls 'displayException' on the exception, which
        -- means the full context is visible on the client, which is most useful
        -- for debugging. However, it is a potential security concern: if the
        -- exception happens to contain sensitive information, this information
        -- will also be visible on the client. You may therefore wish to override
        -- the default behaviour.
      , serverExceptionToClient :: SomeException -> IO (Maybe Text)
  
        -- | Override content-type for response to client.
        --
        -- Set to 'Nothing' to omit the content-type header completely
        -- (this is not conform the gRPC spec).
      , serverContentType :: Maybe ContentType
  
        -- | Verify that all request headers can be parsed
        --
        -- When enabled, we verify at the start of each request that all request
        -- headers are valid. By default we do /not/ do this, throwing an error
        -- only in scenarios where we really cannot continue.
        --
        -- Even if enabled, we will not attempt to parse @rpc@-specific metadata
        -- (merely that the metadata is syntactically correct). See
        -- 'Network.GRPC.Server.getRequestMetadata' for detailed discussion.
      , serverVerifyHeaders :: Bool
      }
  
  instance Default ServerParams where
    def = ServerParams {
          serverCompression       = def
        , serverTopLevel          = defaultServerTopLevel
        , serverExceptionToClient = defaultServerExceptionToClient
        , serverContentType       = Just ContentTypeDefault
        , serverVerifyHeaders     = False
        }
  
  defaultServerTopLevel :: RequestHandler () -> RequestHandler ()
  defaultServerTopLevel h unmask req resp =
      h unmask req resp `catch` handler
    where
      handler :: SomeException -> IO ()
      handler = hPrint stderr
  
  -- | Default implementation for 'serverExceptionToClient'
  --
  -- We unwrap the 'SomeException' wrapper so that we do not include the exception
  -- context in the output to the client (relevant for @ghc >= 9.10@ only).
  --
  -- See <https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0330-exception-backtraces.rst>.
  defaultServerExceptionToClient :: SomeException -> IO (Maybe Text)
  defaultServerExceptionToClient (SomeException e) =
      return $ Just (Text.pack $ "Server-side exception: " ++ displayException e)