{-# LANGUAGE OverloadedStrings #-}
module Network.GRPC.Spec.CustomMetadata.Raw (
CustomMetadata(CustomMetadata)
, customMetadataName
, customMetadataValue
, safeCustomMetadata
, HeaderName(BinaryHeader, AsciiHeader)
, safeHeaderName
, isValidAsciiValue
) where
import Control.DeepSeq (NFData)
import Control.Monad
import Data.ByteString qualified as BS.Strict
import Data.ByteString qualified as Strict (ByteString)
import Data.List qualified as List
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String
import Data.Word
import GHC.Generics (Generic)
import GHC.Show
import GHC.Stack
import Network.GRPC.Spec.Util.ByteString (strip, ascii)
data CustomMetadata = UnsafeCustomMetadata {
CustomMetadata -> HeaderName
customMetadataName :: HeaderName
, CustomMetadata -> ByteString
customMetadataValue :: Strict.ByteString
}
deriving stock (CustomMetadata -> CustomMetadata -> Bool
(CustomMetadata -> CustomMetadata -> Bool)
-> (CustomMetadata -> CustomMetadata -> Bool) -> Eq CustomMetadata
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomMetadata -> CustomMetadata -> Bool
== :: CustomMetadata -> CustomMetadata -> Bool
$c/= :: CustomMetadata -> CustomMetadata -> Bool
/= :: CustomMetadata -> CustomMetadata -> Bool
Eq, (forall x. CustomMetadata -> Rep CustomMetadata x)
-> (forall x. Rep CustomMetadata x -> CustomMetadata)
-> Generic CustomMetadata
forall x. Rep CustomMetadata x -> CustomMetadata
forall x. CustomMetadata -> Rep CustomMetadata x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CustomMetadata -> Rep CustomMetadata x
from :: forall x. CustomMetadata -> Rep CustomMetadata x
$cto :: forall x. Rep CustomMetadata x -> CustomMetadata
to :: forall x. Rep CustomMetadata x -> CustomMetadata
Generic)
deriving anyclass (CustomMetadata -> ()
(CustomMetadata -> ()) -> NFData CustomMetadata
forall a. (a -> ()) -> NFData a
$crnf :: CustomMetadata -> ()
rnf :: CustomMetadata -> ()
NFData)
instance Show CustomMetadata where
showsPrec :: Int -> CustomMetadata -> ShowS
showsPrec Int
p (UnsafeCustomMetadata HeaderName
name ByteString
value) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
appPrec1) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
[Char] -> ShowS
showString [Char]
"CustomMetadata "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> HeaderName -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
appPrec1 HeaderName
name
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
showSpace
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ByteString -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
appPrec1 ByteString
value
isValidAsciiValue :: Strict.ByteString -> Bool
isValidAsciiValue :: ByteString -> Bool
isValidAsciiValue ByteString
bs = (Word8 -> Bool) -> ByteString -> Bool
BS.Strict.all (\Word8
c -> Word8
0x20 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x7E) ByteString
bs
safeCustomMetadata :: HeaderName -> Strict.ByteString -> Maybe CustomMetadata
safeCustomMetadata :: HeaderName -> ByteString -> Maybe CustomMetadata
safeCustomMetadata HeaderName
name ByteString
value =
case HeaderName
name of
UnsafeAsciiHeader ByteString
_ -> do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
isValidAsciiValue ByteString
value
CustomMetadata -> Maybe CustomMetadata
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (CustomMetadata -> Maybe CustomMetadata)
-> CustomMetadata -> Maybe CustomMetadata
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString -> CustomMetadata
UnsafeCustomMetadata HeaderName
name (ByteString -> ByteString
strip ByteString
value)
UnsafeBinaryHeader ByteString
_ ->
CustomMetadata -> Maybe CustomMetadata
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (CustomMetadata -> Maybe CustomMetadata)
-> CustomMetadata -> Maybe CustomMetadata
forall a b. (a -> b) -> a -> b
$ HeaderName -> ByteString -> CustomMetadata
UnsafeCustomMetadata HeaderName
name ByteString
value
pattern CustomMetadata ::
HasCallStack
=> HeaderName -> Strict.ByteString -> CustomMetadata
pattern $bCustomMetadata :: HasCallStack => HeaderName -> ByteString -> CustomMetadata
$mCustomMetadata :: forall {r}.
HasCallStack =>
CustomMetadata
-> (HeaderName -> ByteString -> r) -> ((# #) -> r) -> r
CustomMetadata name value <- UnsafeCustomMetadata name value
where
CustomMetadata HeaderName
name ByteString
value =
CustomMetadata -> Maybe CustomMetadata -> CustomMetadata
forall a. a -> Maybe a -> a
fromMaybe (CustomMetadata -> CustomMetadata
forall a b. (Show a, HasCallStack) => a -> b
invalid CustomMetadata
constructedForError) (Maybe CustomMetadata -> CustomMetadata)
-> Maybe CustomMetadata -> CustomMetadata
forall a b. (a -> b) -> a -> b
$
HeaderName -> ByteString -> Maybe CustomMetadata
safeCustomMetadata HeaderName
name ByteString
value
where
constructedForError :: CustomMetadata
constructedForError :: CustomMetadata
constructedForError = HeaderName -> ByteString -> CustomMetadata
UnsafeCustomMetadata HeaderName
name ByteString
value
{-# COMPLETE CustomMetadata #-}
data =
Strict.ByteString
| Strict.ByteString
deriving stock (HeaderName -> HeaderName -> Bool
(HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> Bool) -> Eq HeaderName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeaderName -> HeaderName -> Bool
== :: HeaderName -> HeaderName -> Bool
$c/= :: HeaderName -> HeaderName -> Bool
/= :: HeaderName -> HeaderName -> Bool
Eq, Eq HeaderName
Eq HeaderName =>
(HeaderName -> HeaderName -> Ordering)
-> (HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> Bool)
-> (HeaderName -> HeaderName -> HeaderName)
-> (HeaderName -> HeaderName -> HeaderName)
-> Ord HeaderName
HeaderName -> HeaderName -> Bool
HeaderName -> HeaderName -> Ordering
HeaderName -> HeaderName -> HeaderName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HeaderName -> HeaderName -> Ordering
compare :: HeaderName -> HeaderName -> Ordering
$c< :: HeaderName -> HeaderName -> Bool
< :: HeaderName -> HeaderName -> Bool
$c<= :: HeaderName -> HeaderName -> Bool
<= :: HeaderName -> HeaderName -> Bool
$c> :: HeaderName -> HeaderName -> Bool
> :: HeaderName -> HeaderName -> Bool
$c>= :: HeaderName -> HeaderName -> Bool
>= :: HeaderName -> HeaderName -> Bool
$cmax :: HeaderName -> HeaderName -> HeaderName
max :: HeaderName -> HeaderName -> HeaderName
$cmin :: HeaderName -> HeaderName -> HeaderName
min :: HeaderName -> HeaderName -> HeaderName
Ord, (forall x. HeaderName -> Rep HeaderName x)
-> (forall x. Rep HeaderName x -> HeaderName) -> Generic HeaderName
forall x. Rep HeaderName x -> HeaderName
forall x. HeaderName -> Rep HeaderName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeaderName -> Rep HeaderName x
from :: forall x. HeaderName -> Rep HeaderName x
$cto :: forall x. Rep HeaderName x -> HeaderName
to :: forall x. Rep HeaderName x -> HeaderName
Generic)
deriving anyclass (HeaderName -> ()
(HeaderName -> ()) -> NFData HeaderName
forall a. (a -> ()) -> NFData a
$crnf :: HeaderName -> ()
rnf :: HeaderName -> ()
NFData)
pattern BinaryHeader :: HasCallStack => Strict.ByteString -> HeaderName
pattern name <- UnsafeBinaryHeader name
where
BinaryHeader ByteString
name =
case ByteString -> Maybe HeaderName
safeHeaderName ByteString
name of
Just name' :: HeaderName
name'@UnsafeBinaryHeader{} ->
HeaderName
name'
Just UnsafeAsciiHeader{} ->
[Char] -> HeaderName
forall a. HasCallStack => [Char] -> a
error [Char]
"binary headers must have -bin suffix"
Maybe HeaderName
Nothing ->
[Char] -> HeaderName
forall a. HasCallStack => [Char] -> a
error ([Char] -> HeaderName) -> [Char] -> HeaderName
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid header name " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
name
pattern AsciiHeader :: HasCallStack => Strict.ByteString -> HeaderName
pattern name <- UnsafeAsciiHeader name
where
AsciiHeader ByteString
name =
case ByteString -> Maybe HeaderName
safeHeaderName ByteString
name of
Just name' :: HeaderName
name'@UnsafeAsciiHeader{} ->
HeaderName
name'
Just UnsafeBinaryHeader{} ->
[Char] -> HeaderName
forall a. HasCallStack => [Char] -> a
error [Char]
"ASCII headers cannot have -bin suffix"
Maybe HeaderName
Nothing ->
[Char] -> HeaderName
forall a. HasCallStack => [Char] -> a
error ([Char] -> HeaderName) -> [Char] -> HeaderName
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid header name " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
name
{-# COMPLETE BinaryHeader, AsciiHeader #-}
safeHeaderName :: Strict.ByteString -> Maybe HeaderName
ByteString
bs = do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.Strict.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> Bool
BS.Strict.all Word8 -> Bool
isValidChar ByteString
bs
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString
"grpc-" ByteString -> ByteString -> Bool
`BS.Strict.isPrefixOf` ByteString
bs
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString
bs ByteString -> Set ByteString -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set ByteString
reservedNames
HeaderName -> Maybe HeaderName
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (HeaderName -> Maybe HeaderName) -> HeaderName -> Maybe HeaderName
forall a b. (a -> b) -> a -> b
$ if ByteString
"-bin" ByteString -> ByteString -> Bool
`BS.Strict.isSuffixOf` ByteString
bs
then ByteString -> HeaderName
UnsafeBinaryHeader ByteString
bs
else ByteString -> HeaderName
UnsafeAsciiHeader ByteString
bs
where
isValidChar :: Word8 -> Bool
isValidChar :: Word8 -> Bool
isValidChar Word8
c = [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [
Word8
0x30 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x39
, Word8
0x61 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
c Bool -> Bool -> Bool
&& Word8
c Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word8
0x7A
, Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'_'
, Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'-'
, Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== HasCallStack => Char -> Word8
Char -> Word8
ascii Char
'.'
]
reservedNames :: Set Strict.ByteString
reservedNames :: Set ByteString
reservedNames = [ByteString] -> Set ByteString
forall a. Ord a => [a] -> Set a
Set.fromList [
ByteString
"user-agent"
, ByteString
"content-type"
, ByteString
"te"
, ByteString
"trailer"
]
instance IsString HeaderName where
fromString :: [Char] -> HeaderName
fromString [Char]
str =
HeaderName -> Maybe HeaderName -> HeaderName
forall a. a -> Maybe a -> a
fromMaybe (HeaderName -> HeaderName
forall a b. (Show a, HasCallStack) => a -> b
invalid HeaderName
constructedForError) (Maybe HeaderName -> HeaderName) -> Maybe HeaderName -> HeaderName
forall a b. (a -> b) -> a -> b
$
ByteString -> Maybe HeaderName
safeHeaderName ([Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString [Char]
str)
where
constructedForError :: HeaderName
constructedForError :: HeaderName
constructedForError =
if [Char]
"-bin" [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`List.isSuffixOf` [Char]
str
then ByteString -> HeaderName
UnsafeBinaryHeader (ByteString -> HeaderName) -> ByteString -> HeaderName
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString [Char]
str
else ByteString -> HeaderName
UnsafeAsciiHeader (ByteString -> HeaderName) -> ByteString -> HeaderName
forall a b. (a -> b) -> a -> b
$ [Char] -> ByteString
forall a. IsString a => [Char] -> a
fromString [Char]
str
instance Show HeaderName where
show :: HeaderName -> [Char]
show (UnsafeBinaryHeader ByteString
name) = ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
name
show (UnsafeAsciiHeader ByteString
name) = ByteString -> [Char]
forall a. Show a => a -> [Char]
show ByteString
name
invalid :: (Show a, HasCallStack) => a -> b
invalid :: forall a b. (Show a, HasCallStack) => a -> b
invalid a
x = [Char] -> b
forall a. HasCallStack => [Char] -> a
error ([Char] -> b) -> [Char] -> b
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
x [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" at "