module Network.GRPC.Spec.CustomMetadata.Typed (
    -- * Map RPC to metadata
    RequestMetadata
  , ResponseInitialMetadata
  , ResponseTrailingMetadata
  , ResponseMetadata(..)
    -- * Serialization
  , BuildMetadata(..)
  , StaticMetadata(..)
  , ParseMetadata(..)
  , UnexpectedMetadata(..)
  , buildMetadataIO
  ) where

import Control.DeepSeq (force)
import Control.Exception
import Control.Monad.Catch
import Data.Kind
import Data.Proxy

import Network.GRPC.Spec.CustomMetadata.Raw

{-------------------------------------------------------------------------------
  Map RPC to metadata
-------------------------------------------------------------------------------}

-- | Metadata included in the request
--
-- Often you can give a blanket metadata definition for all methods in a
-- service. For example:
--
-- > type instance RequestMetadata          (Protobuf RouteGuide meth) = NoMetadata
-- > type instance ResponseInitialMetadata  (Protobuf RouteGuide meth) = NoMetadata
-- > type instance ResponseTrailingMetadata (Protobuf RouteGuide meth) = NoMetadata
--
-- If you want to give specific types of metadata for specific methods but not
-- for others, it can sometimes be useful to introduce an auxiliary closed type,
-- so that you can give a catch-all case. For example:
--
-- > type instance ResponseInitialMetadata (Protobuf Greeter meth) = GreeterResponseInitialMetadata meth
-- >
-- > type family GreeterResponseInitialMetadata (meth :: Symbol) where
-- >   GreeterResponseInitialMetadata "sayHelloStreamReply" = SayHelloMetadata
-- >   GreeterResponseInitialMetadata meth                  = NoMetadata
type family RequestMetadata (rpc :: k) :: Type

-- | Metadata included in the initial response
--
-- See 'RequestMetadata' for discussion.
type family ResponseInitialMetadata (rpc :: k) :: Type

-- | Metadata included in the response trailers
--
-- See 'RequestMetadata' for discussion.
type family ResponseTrailingMetadata (rpc :: k) :: Type

-- | Response metadata
--
-- It occassionally happens that we do not know if we should expect the initial
-- metadata from the server or the trailing metadata (when the server uses
-- Trailers-Only); for example, see
-- 'Network.GRPC.Client.recvResponseInitialMetadata'.
data ResponseMetadata rpc =
    ResponseInitialMetadata  (ResponseInitialMetadata  rpc)
  | ResponseTrailingMetadata (ResponseTrailingMetadata rpc)

deriving stock instance
     ( Show (ResponseInitialMetadata rpc)
     , Show (ResponseTrailingMetadata rpc)
     )
  => Show (ResponseMetadata rpc)

deriving stock instance
     ( Eq (ResponseInitialMetadata rpc)
     , Eq (ResponseTrailingMetadata rpc)
     )
  => Eq (ResponseMetadata rpc)

{-------------------------------------------------------------------------------
  Serialization
-------------------------------------------------------------------------------}

-- | Serialize metadata to custom metadata headers
class BuildMetadata a where
  buildMetadata :: a -> [CustomMetadata]

-- | Wrapper around 'buildMetadata' that catches any pure exceptions
--
-- These pure exceptions can arise when invalid headers are generated (for
-- example, ASCII headers with non-ASCII values).
buildMetadataIO :: BuildMetadata a => a -> IO [CustomMetadata]
buildMetadataIO :: forall a. BuildMetadata a => a -> IO [CustomMetadata]
buildMetadataIO = [CustomMetadata] -> IO [CustomMetadata]
forall a. a -> IO a
evaluate ([CustomMetadata] -> IO [CustomMetadata])
-> (a -> [CustomMetadata]) -> a -> IO [CustomMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CustomMetadata] -> [CustomMetadata]
forall a. NFData a => a -> a
force ([CustomMetadata] -> [CustomMetadata])
-> (a -> [CustomMetadata]) -> a -> [CustomMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [CustomMetadata]
forall a. BuildMetadata a => a -> [CustomMetadata]
buildMetadata

-- | Metadata with statically known fields
--
-- This is required for the response trailing metadata. When the server sends
-- the /initial/ set of headers to the client, it must tell the client which
-- trailers to expect (by means of the HTTP @Trailer@ header; see
-- <https://datatracker.ietf.org/doc/html/rfc7230#section-4.4>).
--
-- Any headers constructed in 'buildMetadata' /must/ be listed here; not doing
-- so is a bug. However, the converse is not true: it is acceptable for a header
-- to be listed in 'metadataHeaderNames' but not in 'buildMetadata'. Put another
-- way: the list of "trailers to expect" included in the initial request headers
-- is allowed to be an overapproximation, but not an underapproximation.
class BuildMetadata a => StaticMetadata a where
  metadataHeaderNames :: Proxy a -> [HeaderName]

-- | Parse metadata from custom metadata headers
--
-- Some guidelines for defining instances:
--
-- * You can assume that the list of headers will not contain duplicates. The
--   gRPC spec /does/ allow for duplicate headers and specifies how to process
--   them, but this will be taken care of before 'parseMetadata' is called.
-- * However, you should assume no particular /order/.
-- * If there are unexpected headers present, you have a choice whether you want
--   to consider this a error and throw an exception, or regard the additional
--   headers as merely additional information and simply ignore them. There is
--   no single right answer here: ignoring additional metadata runs the risk of
--   not realizing that the peer is trying to tell you something important, but
--   throwing an error runs the risk of unnecessarily aborting an RPC.
class ParseMetadata a where
  parseMetadata :: MonadThrow m => [CustomMetadata] -> m a

-- | Unexpected metadata
--
-- This exception can be thrown in 'ParseMetadata' instances. See 'ParseMetadata'
-- for discussion.
data UnexpectedMetadata = UnexpectedMetadata [CustomMetadata]
  deriving stock (Int -> UnexpectedMetadata -> ShowS
[UnexpectedMetadata] -> ShowS
UnexpectedMetadata -> String
(Int -> UnexpectedMetadata -> ShowS)
-> (UnexpectedMetadata -> String)
-> ([UnexpectedMetadata] -> ShowS)
-> Show UnexpectedMetadata
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UnexpectedMetadata -> ShowS
showsPrec :: Int -> UnexpectedMetadata -> ShowS
$cshow :: UnexpectedMetadata -> String
show :: UnexpectedMetadata -> String
$cshowList :: [UnexpectedMetadata] -> ShowS
showList :: [UnexpectedMetadata] -> ShowS
Show)
  deriving anyclass (Show UnexpectedMetadata
Typeable UnexpectedMetadata
(Typeable UnexpectedMetadata, Show UnexpectedMetadata) =>
(UnexpectedMetadata -> SomeException)
-> (SomeException -> Maybe UnexpectedMetadata)
-> (UnexpectedMetadata -> String)
-> (UnexpectedMetadata -> Bool)
-> Exception UnexpectedMetadata
SomeException -> Maybe UnexpectedMetadata
UnexpectedMetadata -> Bool
UnexpectedMetadata -> String
UnexpectedMetadata -> SomeException
forall e.
(Typeable e, Show e) =>
(e -> SomeException)
-> (SomeException -> Maybe e)
-> (e -> String)
-> (e -> Bool)
-> Exception e
$ctoException :: UnexpectedMetadata -> SomeException
toException :: UnexpectedMetadata -> SomeException
$cfromException :: SomeException -> Maybe UnexpectedMetadata
fromException :: SomeException -> Maybe UnexpectedMetadata
$cdisplayException :: UnexpectedMetadata -> String
displayException :: UnexpectedMetadata -> String
$cbacktraceDesired :: UnexpectedMetadata -> Bool
backtraceDesired :: UnexpectedMetadata -> Bool
Exception)