module Network.GRPC.Util.Session.API (
    -- * Preliminaries
    RequestInfo(..)
  , ResponseInfo(..)
    -- * Main definitions
  , DataFlow(..)
  , FlowStart(..)
  , IsSession(..)
  , InitiateSession(..)
    -- * Exceptions
  , PeerException(..)
  ) where

import Control.Exception
import Data.ByteString.Builder (Builder)
import Data.ByteString.Lazy qualified as Lazy (ByteString)
import Data.Kind
import Network.HTTP.Types qualified as HTTP

-- Doesn't really matter if we import this from .Client or .Server
import Network.HTTP2.Client qualified as HTTP2 (Path)

import Network.GRPC.Spec.Util.Parser (Parser)

{-------------------------------------------------------------------------------
  Preliminaries
-------------------------------------------------------------------------------}

data RequestInfo = RequestInfo {
      RequestInfo -> Method
requestMethod  :: HTTP.Method
    , RequestInfo -> Method
requestPath    :: HTTP2.Path
    , RequestInfo -> [Header]
requestHeaders :: [HTTP.Header]
    }
  deriving (Int -> RequestInfo -> ShowS
[RequestInfo] -> ShowS
RequestInfo -> String
(Int -> RequestInfo -> ShowS)
-> (RequestInfo -> String)
-> ([RequestInfo] -> ShowS)
-> Show RequestInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RequestInfo -> ShowS
showsPrec :: Int -> RequestInfo -> ShowS
$cshow :: RequestInfo -> String
show :: RequestInfo -> String
$cshowList :: [RequestInfo] -> ShowS
showList :: [RequestInfo] -> ShowS
Show)

data ResponseInfo = ResponseInfo {
      ResponseInfo -> Status
responseStatus  :: HTTP.Status
    , ResponseInfo -> [Header]
responseHeaders :: [HTTP.Header]
    , ResponseInfo -> Maybe ByteString
responseBody    :: Maybe Lazy.ByteString -- ^ Only for errors
    }
  deriving (Int -> ResponseInfo -> ShowS
[ResponseInfo] -> ShowS
ResponseInfo -> String
(Int -> ResponseInfo -> ShowS)
-> (ResponseInfo -> String)
-> ([ResponseInfo] -> ShowS)
-> Show ResponseInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ResponseInfo -> ShowS
showsPrec :: Int -> ResponseInfo -> ShowS
$cshow :: ResponseInfo -> String
show :: ResponseInfo -> String
$cshowList :: [ResponseInfo] -> ShowS
showList :: [ResponseInfo] -> ShowS
Show)

{-------------------------------------------------------------------------------
  Main definition
-------------------------------------------------------------------------------}

-- | Flow of data in a session
--
-- This describes the flow of data in /one/ direction. The normal flow of data
-- is as follows:
--
-- 1. (Proper) Headers
-- 2. Messages
-- 3. Trailers
--
-- However, in the case that there /are/ no messages, this whole thing collapses
-- and we just have headers (in gRPC this is referred to as the Trailers-Only
-- case, but we avoid that terminology here).
--
-- * It looks different on the wire: in the regular case, we will have /two/
--   HTTP @Headers@ frames, but in the absence of messages we only have one.
-- * Applications may in turn treat this case special, using a different set of
--   headers (specifically, this is the case for gRPC).
class ( Show (Headers    flow)
      , Show (Message    flow)
      , Show (Trailers   flow)
      , Show (NoMessages flow)
      ) => DataFlow flow where
  data Headers    flow :: Type
  type Message    flow :: Type
  type Trailers   flow :: Type
  type NoMessages flow :: Type

-- | Start of data flow
--
-- See 'DataFlow' for discussion.
data FlowStart flow =
    FlowStartRegular    (Headers    flow)
  | FlowStartNoMessages (NoMessages flow)

deriving instance DataFlow flow => Show (FlowStart flow)

-- | Session between two nodes in the network
--
-- The session is described from the point of view of /this/ node, who is
-- talking to a peer node. For example, if this node is a client, then the peer
-- is a server, the outbound headers correspond to a request and the inbound
-- headers correspond to a response (see also 'InitiateSession').
--
-- We avoid referring to \"inputs\" or \"outputs\" here, but instead talk about
-- \"inbound\" or \"outbound\". When we are dealing with gRPC, \"inputs\" are
-- outbound for the client and inbound for the server, and \"outputs\" are
-- inbound for the client and outbound for the server.
class ( DataFlow (Inbound  sess)
      , DataFlow (Outbound sess)
      ) => IsSession sess where
  type Inbound  sess :: Type
  type Outbound sess :: Type

  -- | Parse proper trailers
  parseInboundTrailers ::
       sess
    -> [HTTP.Header]
    -> IO (Trailers (Inbound sess))

  -- | Build proper trailers
  buildOutboundTrailers ::
       sess
    -> Trailers (Outbound sess)
    -> [HTTP.Header]

  -- | Parse message
  parseMsg ::
       sess
    -> Headers (Inbound sess)
    -> Parser String (Message (Inbound sess))

  -- | Build message
  buildMsg ::
       sess
    -> Headers (Outbound sess)
    -> Message (Outbound sess)
    -> Builder

-- | Initiate new session
--
-- A client node connects to a server, and initiates the request.
class IsSession sess => InitiateSession sess where
  -- | Build 'RequestInfo' for the server
  buildRequestInfo ::
       sess
    -> FlowStart (Outbound sess) -> RequestInfo

  -- | Parse 'ResponseInfo' from the server
  parseResponse ::
      sess
   -> ResponseInfo
   -> IO (FlowStart (Inbound sess))

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

-- | Misbehaving peer
--
-- Although this exception could in principle be caught, there is not much that
-- can be done to rectify the situation: probably this peer should just be
-- avoided (although perhaps one can hope that the problem was transient).
data PeerException =
    -- | Peer sent a malformed message (parser returned an error)
    PeerSentMalformedMessage String

    -- | Peer sent an incomplete message (parser did not consume all data)
  | PeerSentIncompleteMessage

    -- | HTTP response missing @:status@ pseudo-header
    --
    -- This is not part of 'CallSetupFailure' because the call may have been
    -- well under way before the server initiates a response.
  | PeerMissingPseudoHeaderStatus
  deriving stock (Int -> PeerException -> ShowS
[PeerException] -> ShowS
PeerException -> String
(Int -> PeerException -> ShowS)
-> (PeerException -> String)
-> ([PeerException] -> ShowS)
-> Show PeerException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PeerException -> ShowS
showsPrec :: Int -> PeerException -> ShowS
$cshow :: PeerException -> String
show :: PeerException -> String
$cshowList :: [PeerException] -> ShowS
showList :: [PeerException] -> ShowS
Show)
  deriving anyclass (Show PeerException
Typeable PeerException
(Typeable PeerException, Show PeerException) =>
(PeerException -> SomeException)
-> (SomeException -> Maybe PeerException)
-> (PeerException -> String)
-> (PeerException -> Bool)
-> Exception PeerException
SomeException -> Maybe PeerException
PeerException -> Bool
PeerException -> String
PeerException -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: PeerException -> SomeException
toException :: PeerException -> SomeException
$cfromException :: SomeException -> Maybe PeerException
fromException :: SomeException -> Maybe PeerException
$cdisplayException :: PeerException -> String
displayException :: PeerException -> String
$cbacktraceDesired :: PeerException -> Bool
backtraceDesired :: PeerException -> Bool
Exception)