module Network.GRPC.Spec.Headers.Common (
ContentType(..)
, chooseContentType
, MessageType(..)
, chooseMessageType
) where
import Data.ByteString qualified as Strict (ByteString)
import Data.Default
import Data.Proxy
import GHC.Generics (Generic)
import Network.GRPC.Spec.RPC
data ContentType =
ContentTypeDefault
| ContentTypeOverride Strict.ByteString
deriving stock (Int -> ContentType -> ShowS
[ContentType] -> ShowS
ContentType -> String
(Int -> ContentType -> ShowS)
-> (ContentType -> String)
-> ([ContentType] -> ShowS)
-> Show ContentType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContentType -> ShowS
showsPrec :: Int -> ContentType -> ShowS
$cshow :: ContentType -> String
show :: ContentType -> String
$cshowList :: [ContentType] -> ShowS
showList :: [ContentType] -> ShowS
Show, ContentType -> ContentType -> Bool
(ContentType -> ContentType -> Bool)
-> (ContentType -> ContentType -> Bool) -> Eq ContentType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ContentType -> ContentType -> Bool
== :: ContentType -> ContentType -> Bool
$c/= :: ContentType -> ContentType -> Bool
/= :: ContentType -> ContentType -> Bool
Eq, (forall x. ContentType -> Rep ContentType x)
-> (forall x. Rep ContentType x -> ContentType)
-> Generic ContentType
forall x. Rep ContentType x -> ContentType
forall x. ContentType -> Rep ContentType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ContentType -> Rep ContentType x
from :: forall x. ContentType -> Rep ContentType x
$cto :: forall x. Rep ContentType x -> ContentType
to :: forall x. Rep ContentType x -> ContentType
Generic)
instance Default ContentType where
def :: ContentType
def = ContentType
ContentTypeDefault
chooseContentType :: IsRPC rpc => Proxy rpc -> ContentType -> Strict.ByteString
chooseContentType :: forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> ContentType -> ByteString
chooseContentType Proxy rpc
p ContentType
ContentTypeDefault = Proxy rpc -> ByteString
forall k (rpc :: k). IsRPC rpc => Proxy rpc -> ByteString
rpcContentType Proxy rpc
p
chooseContentType Proxy rpc
_ (ContentTypeOverride ByteString
ct) = ByteString
ct
data MessageType =
MessageTypeDefault
| MessageTypeOverride Strict.ByteString
deriving stock (Int -> MessageType -> ShowS
[MessageType] -> ShowS
MessageType -> String
(Int -> MessageType -> ShowS)
-> (MessageType -> String)
-> ([MessageType] -> ShowS)
-> Show MessageType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MessageType -> ShowS
showsPrec :: Int -> MessageType -> ShowS
$cshow :: MessageType -> String
show :: MessageType -> String
$cshowList :: [MessageType] -> ShowS
showList :: [MessageType] -> ShowS
Show, MessageType -> MessageType -> Bool
(MessageType -> MessageType -> Bool)
-> (MessageType -> MessageType -> Bool) -> Eq MessageType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MessageType -> MessageType -> Bool
== :: MessageType -> MessageType -> Bool
$c/= :: MessageType -> MessageType -> Bool
/= :: MessageType -> MessageType -> Bool
Eq, (forall x. MessageType -> Rep MessageType x)
-> (forall x. Rep MessageType x -> MessageType)
-> Generic MessageType
forall x. Rep MessageType x -> MessageType
forall x. MessageType -> Rep MessageType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. MessageType -> Rep MessageType x
from :: forall x. MessageType -> Rep MessageType x
$cto :: forall x. Rep MessageType x -> MessageType
to :: forall x. Rep MessageType x -> MessageType
Generic)
instance Default MessageType where
def :: MessageType
def = MessageType
MessageTypeDefault
chooseMessageType ::
IsRPC rpc
=> Proxy rpc -> MessageType -> Maybe Strict.ByteString
chooseMessageType :: forall {k} (rpc :: k).
IsRPC rpc =>
Proxy rpc -> MessageType -> Maybe ByteString
chooseMessageType Proxy rpc
p MessageType
MessageTypeDefault = Proxy rpc -> Maybe ByteString
forall k (rpc :: k).
(IsRPC rpc, HasCallStack) =>
Proxy rpc -> Maybe ByteString
rpcMessageType Proxy rpc
p
chooseMessageType Proxy rpc
_ (MessageTypeOverride ByteString
mt) = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
mt