module Network.GRPC.Server.Session (
    ServerSession(..)
  , ServerInbound
  , ServerOutbound
  , Headers(..)
    -- * Exceptions
  , CallSetupFailure(..)
  ) where

import Control.Exception
import Data.Proxy
import Data.Void

import Network.GRPC.Server.Context
import Network.GRPC.Spec
import Network.GRPC.Spec.Serialization
import Network.GRPC.Util.Session

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

data ServerSession rpc = ServerSession {
      forall {k} (rpc :: k). ServerSession rpc -> ServerContext
serverSessionContext :: ServerContext
    }

{-------------------------------------------------------------------------------
  Instances
-------------------------------------------------------------------------------}

data ServerInbound rpc
data ServerOutbound rpc

instance IsRPC rpc => DataFlow (ServerInbound rpc) where
  data Headers (ServerInbound rpc) = InboundHeaders {
        forall k (rpc :: k).
Headers (ServerInbound rpc) -> RequestHeaders' HandledSynthesized
inbHeaders     :: RequestHeaders' HandledSynthesized
      , forall k (rpc :: k). Headers (ServerInbound rpc) -> Compression
inbCompression :: Compression
      }
    deriving (Int -> Headers (ServerInbound rpc) -> ShowS
[Headers (ServerInbound rpc)] -> ShowS
Headers (ServerInbound rpc) -> String
(Int -> Headers (ServerInbound rpc) -> ShowS)
-> (Headers (ServerInbound rpc) -> String)
-> ([Headers (ServerInbound rpc)] -> ShowS)
-> Show (Headers (ServerInbound rpc))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (rpc :: k). Int -> Headers (ServerInbound rpc) -> ShowS
forall k (rpc :: k). [Headers (ServerInbound rpc)] -> ShowS
forall k (rpc :: k). Headers (ServerInbound rpc) -> String
$cshowsPrec :: forall k (rpc :: k). Int -> Headers (ServerInbound rpc) -> ShowS
showsPrec :: Int -> Headers (ServerInbound rpc) -> ShowS
$cshow :: forall k (rpc :: k). Headers (ServerInbound rpc) -> String
show :: Headers (ServerInbound rpc) -> String
$cshowList :: forall k (rpc :: k). [Headers (ServerInbound rpc)] -> ShowS
showList :: [Headers (ServerInbound rpc)] -> ShowS
Show)

  type Message  (ServerInbound rpc) = (InboundMeta, Input rpc)
  type Trailers (ServerInbound rpc) = NoMetadata

  -- gRPC does not support request trailers
  type NoMessages (ServerInbound rpc) = Void

instance IsRPC rpc => DataFlow (ServerOutbound rpc) where
  data Headers (ServerOutbound rpc) = OutboundHeaders {
        forall k (rpc :: k).
Headers (ServerOutbound rpc) -> ResponseHeaders
outHeaders     :: ResponseHeaders
      , forall k (rpc :: k). Headers (ServerOutbound rpc) -> Compression
outCompression :: Compression
      }
    deriving (Int -> Headers (ServerOutbound rpc) -> ShowS
[Headers (ServerOutbound rpc)] -> ShowS
Headers (ServerOutbound rpc) -> String
(Int -> Headers (ServerOutbound rpc) -> ShowS)
-> (Headers (ServerOutbound rpc) -> String)
-> ([Headers (ServerOutbound rpc)] -> ShowS)
-> Show (Headers (ServerOutbound rpc))
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (rpc :: k). Int -> Headers (ServerOutbound rpc) -> ShowS
forall k (rpc :: k). [Headers (ServerOutbound rpc)] -> ShowS
forall k (rpc :: k). Headers (ServerOutbound rpc) -> String
$cshowsPrec :: forall k (rpc :: k). Int -> Headers (ServerOutbound rpc) -> ShowS
showsPrec :: Int -> Headers (ServerOutbound rpc) -> ShowS
$cshow :: forall k (rpc :: k). Headers (ServerOutbound rpc) -> String
show :: Headers (ServerOutbound rpc) -> String
$cshowList :: forall k (rpc :: k). [Headers (ServerOutbound rpc)] -> ShowS
showList :: [Headers (ServerOutbound rpc)] -> ShowS
Show)

  type Message    (ServerOutbound rpc) = (OutboundMeta, Output rpc)
  type Trailers   (ServerOutbound rpc) = ProperTrailers
  type NoMessages (ServerOutbound rpc) = TrailersOnly

instance SupportsServerRpc rpc => IsSession (ServerSession rpc) where
  type Inbound  (ServerSession rpc) = ServerInbound rpc
  type Outbound (ServerSession rpc) = ServerOutbound rpc

  parseInboundTrailers :: ServerSession rpc
-> [Header] -> IO (Trailers (Inbound (ServerSession rpc)))
parseInboundTrailers  ServerSession rpc
_ = \[Header]
_ -> NoMetadata -> IO NoMetadata
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return NoMetadata
NoMetadata
  buildOutboundTrailers :: ServerSession rpc
-> Trailers (Outbound (ServerSession rpc)) -> [Header]
buildOutboundTrailers ServerSession rpc
_ = ProperTrailers -> [Header]
Trailers (Outbound (ServerSession rpc)) -> [Header]
buildProperTrailers

  parseMsg :: ServerSession rpc
-> Headers (Inbound (ServerSession rpc))
-> Parser String (Message (Inbound (ServerSession rpc)))
parseMsg ServerSession rpc
_ = Proxy rpc -> Compression -> Parser String (InboundMeta, Input rpc)
forall {k} (rpc :: k).
SupportsServerRpc rpc =>
Proxy rpc -> Compression -> Parser String (InboundMeta, Input rpc)
parseInput  (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @rpc) (Compression -> Parser String (InboundMeta, Input rpc))
-> (Headers (ServerInbound rpc) -> Compression)
-> Headers (ServerInbound rpc)
-> Parser String (InboundMeta, Input rpc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Headers (ServerInbound rpc) -> Compression
forall k (rpc :: k). Headers (ServerInbound rpc) -> Compression
inbCompression
  buildMsg :: ServerSession rpc
-> Headers (Outbound (ServerSession rpc))
-> Message (Outbound (ServerSession rpc))
-> Builder
buildMsg ServerSession rpc
_ = Proxy rpc -> Compression -> (OutboundMeta, Output rpc) -> Builder
forall {k} (rpc :: k).
SupportsServerRpc rpc =>
Proxy rpc -> Compression -> (OutboundMeta, Output rpc) -> Builder
buildOutput (forall (t :: k). Proxy t
forall {k} (t :: k). Proxy t
Proxy @rpc) (Compression -> (OutboundMeta, Output rpc) -> Builder)
-> (Headers (ServerOutbound rpc) -> Compression)
-> Headers (ServerOutbound rpc)
-> (OutboundMeta, Output rpc)
-> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Headers (ServerOutbound rpc) -> Compression
forall k (rpc :: k). Headers (ServerOutbound rpc) -> Compression
outCompression

{-------------------------------------------------------------------------------
  Exceptions
-------------------------------------------------------------------------------}

-- | We failed to setup the call from the client
data CallSetupFailure =
    -- | Client sent resource headers that were not conform the gRPC spec
    CallSetupInvalidResourceHeaders InvalidResourceHeaders

    -- | Invalid request headers
    --
    -- 'CallSetupInvalidResourceHeaders' refers to an invalid method (anything
    -- other than POST) or an invalid path; 'CallSetupInvalidRequestHeaders'
    -- means we could not parse the HTTP headers according to the gRPC spec.
  | CallSetupInvalidRequestHeaders (InvalidHeaders HandledSynthesized)

    -- | Client chose unsupported compression algorithm
    --
    -- This is indicative of a misbehaving peer: a client should not use a
    -- compression algorithm unless they have evidence that the server supports
    -- it. The server cannot process such a request, as it has no way of
    -- decompression messages sent by the client.
  | CallSetupUnsupportedCompression CompressionId

    -- | No registered handler for the specified path
    --
    -- Note on terminology: HTTP has \"methods\" such as POST, GET, etc; gRPC
    -- supports only POST, and when another HTTP method is chosen, this will
    -- result in 'CallSetupInvalidResourceHeaders'. However, gRPC itself also
    -- has the concept of a "method" (a method, or gRPC call, supported by a
    -- particular service); it's these methods that
    -- 'CallSetupUnimplementedMethod' is referring to.
  | CallSetupUnimplementedMethod Path

    -- | An exception arose while we tried to look up the handler
    --
    -- This can arise when the list of handlers /itself/ is @undefined@.
  | CallSetupHandlerLookupException SomeException

deriving stock    instance Show      CallSetupFailure
deriving anyclass instance Exception CallSetupFailure