content: {-# LANGUAGE OverloadedStrings #-}
  
  -- | Custom metadata
  --
  -- These are application-defined headers/trailers.
  --
  -- Intended for unqualified import.
  module Network.GRPC.Spec.CustomMetadata.Raw (
      -- * Definition
      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)
  
  {-------------------------------------------------------------------------------
    Definition
  
    > Custom-Metadata → Binary-Header / ASCII-Header
    > Binary-Header   → {Header-Name "-bin" } {base64 encoded value}
    > ASCII-Header    → Header-Name ASCII-Value
  
    Implementation note: ASCII headers and binary headers are distinguished based
    on their name (see 'HeaderName'). We do /not/ introduce a different type for
    the /values/ of such headers, because if we did, we would then need additional
    machinery to make sure that binary header names are paired with binary header
    values, and similarly for ASCII headers, with little benefit. Instead we check
    in the smart constructor for 'CustomMetadata' that the header value satisfies
    the rules for the particular type of header.
  -------------------------------------------------------------------------------}
  
  -- | Custom metadata
  --
  -- This is an arbitrary set of key-value pairs defined by the application layer.
  --
  -- Custom metadata order is not guaranteed to be preserved except for values
  -- with duplicate header names. Duplicate header names may have their values
  -- joined with "," as the delimiter and be considered semantically equivalent.
  data CustomMetadata = UnsafeCustomMetadata {
        -- | Header name
        --
        -- The header name determines if this is an ASCII header or a binary
        -- header; see the t'CustomMetadata' pattern synonym.
        customMetadataName :: HeaderName
  
        -- | Header value
      , customMetadataValue :: Strict.ByteString
      }
    deriving stock (Eq, Generic)
    deriving anyclass (NFData)
  
  -- | 'Show' instance relies on the v'CustomMetadata' pattern synonym
  instance Show CustomMetadata where
    showsPrec p (UnsafeCustomMetadata name value) = showParen (p >= appPrec1) $
           showString "CustomMetadata "
         . showsPrec appPrec1 name
         . showSpace
         . showsPrec appPrec1 value
  
  -- | Check for valid ASCII header value
  --
  -- > ASCII-Value → 1*( %x20-%x7E ) ; space and printable ASCII
  --
  -- NOTE: By rights this should verify that the header is non-empty. However,
  -- empty header values do occasionally show up, and so we permit them. The main
  -- reason for checking for validity at all is to ensure that we don't confuse
  -- binary headers and ASCII headers.
  isValidAsciiValue :: Strict.ByteString -> Bool
  isValidAsciiValue bs = BS.Strict.all (\c -> 0x20 <= c && c <= 0x7E) bs
  
  -- | Construct t'CustomMetadata'
  --
  -- Returns 'Nothing' if the 'HeaderName' indicates an ASCII header but the
  -- value is not valid ASCII (consider using a binary header instead).
  safeCustomMetadata :: HeaderName -> Strict.ByteString -> Maybe CustomMetadata
  safeCustomMetadata name value =
      case name of
        UnsafeAsciiHeader _ -> do
          guard $ isValidAsciiValue value
          return $ UnsafeCustomMetadata name (strip value)
        UnsafeBinaryHeader _ ->
          -- Values of binary headers are not subject to any constraints
          return $ UnsafeCustomMetadata name value
  
  pattern CustomMetadata ::
       HasCallStack
    => HeaderName -> Strict.ByteString -> CustomMetadata
  pattern CustomMetadata name value <- UnsafeCustomMetadata name value
    where
      CustomMetadata name value =
          fromMaybe (invalid constructedForError) $
            safeCustomMetadata name value
        where
          constructedForError :: CustomMetadata
          constructedForError = UnsafeCustomMetadata name value
  
  {-# COMPLETE CustomMetadata #-}
  
  {-------------------------------------------------------------------------------
    Header-Name
  
    > Header-Name → 1*( %x30-39 / %x61-7A / "_" / "-" / ".") ; 0-9 a-z _ - .
  ----------------------\--------------------------------------------------------}
  
  -- | Header name
  --
  -- To construct a 'HeaderName', you can either use the 'IsString' instance
  --
  -- > "foo"     :: HeaderName -- an ASCII header
  -- > "bar-bin" :: HeaderName -- a binary header
  --
  -- or alternatively use the 'AsciiHeader' and 'BinaryHeader' patterns
  --
  -- > AsciiHeader  "foo"
  -- > BinaryHeader "bar-bin"
  --
  -- The latter style is more explicit, and can catch more errors:
  --
  -- > AsciiHeader  "foo-bin" -- exception: unexpected -bin suffix
  -- > BinaryHeader "bar"     -- exception: expected   -bin suffix
  --
  -- Header names cannot be empty, and must consist of digits (@0-9@), lowercase
  -- letters (@a-z@), underscore (@_@), hyphen (@-@), or period (@.@).
  -- Reserved header names are disallowed.
  --
  -- See also 'safeHeaderName'.
  data HeaderName =
      -- | Binary header
      --
      -- Binary headers will be base-64 encoded.
      --
      -- The header name must have a @-bin@ suffix (runtime libraries use this
      -- suffix to detect binary headers and properly apply base64 encoding &
      -- decoding as headers are sent and received).
      --
      -- Since this is binary data, padding considerations do not apply.
      UnsafeBinaryHeader Strict.ByteString
  
      -- | ASCII header
      --
      -- ASCII headers cannot be empty, and can only use characters in the range
      -- @0x20 .. 0x7E@. Note that although this range includes whitespace, any
      -- padding will be removed when constructing the value.
      --
      -- The gRPC spec is not precise about what exactly constitutes \"padding\",
      -- but the ABNF spec defines it as "space and horizontal tab"
      -- <https://www.rfc-editor.org/rfc/rfc5234#section-3.1>.
    | UnsafeAsciiHeader Strict.ByteString
    deriving stock (Eq, Ord, Generic)
    deriving anyclass (NFData)
  
  pattern BinaryHeader :: HasCallStack => Strict.ByteString -> HeaderName
  pattern BinaryHeader name <- UnsafeBinaryHeader name
    where
      BinaryHeader name =
        case safeHeaderName name of
          Just name'@UnsafeBinaryHeader{} ->
            name'
          Just UnsafeAsciiHeader{} ->
            error "binary headers must have -bin suffix"
          Nothing ->
            error $ "Invalid header name " ++ show name
  
  pattern AsciiHeader :: HasCallStack => Strict.ByteString -> HeaderName
  pattern AsciiHeader name <- UnsafeAsciiHeader name
    where
      AsciiHeader name =
        case safeHeaderName name of
          Just name'@UnsafeAsciiHeader{} ->
            name'
          Just UnsafeBinaryHeader{} ->
            error "ASCII headers cannot have -bin suffix"
          Nothing ->
            error $ "Invalid header name " ++ show name
  
  {-# COMPLETE BinaryHeader, AsciiHeader #-}
  
  -- | Check for header name validity
  --
  -- We choose between 'BinaryHeader' and 'AsciiHeader' based on the presence or
  -- absence of a @-bin suffix.
  safeHeaderName :: Strict.ByteString -> Maybe HeaderName
  safeHeaderName bs = do
      guard $ BS.Strict.length bs >= 1
      guard $ BS.Strict.all isValidChar bs
      guard $ not $ "grpc-" `BS.Strict.isPrefixOf` bs
      guard $ not $ bs `Set.member` reservedNames
      return $ if "-bin" `BS.Strict.isSuffixOf` bs
                 then UnsafeBinaryHeader bs
                 else UnsafeAsciiHeader  bs
    where
      isValidChar :: Word8 -> Bool
      isValidChar c = or [
            0x30 <= c && c <= 0x39
          , 0x61 <= c && c <= 0x7A
          , c == ascii '_'
          , c == ascii '-'
          , c == ascii '.'
          ]
  
      -- Reserved header names that do not start with @grpc-@
      reservedNames :: Set Strict.ByteString
      reservedNames = Set.fromList [
            "user-agent"
          , "content-type"
          , "te"
          , "trailer"
          ]
  
  instance IsString HeaderName where
    fromString str =
         fromMaybe (invalid constructedForError) $
           safeHeaderName (fromString str)
      where
        constructedForError :: HeaderName
        constructedForError =
            if "-bin" `List.isSuffixOf` str
              then UnsafeBinaryHeader $ fromString str
              else UnsafeAsciiHeader  $ fromString str
  
  -- | 'Show' instance relies on the 'IsString' instance
  instance Show HeaderName where
    show (UnsafeBinaryHeader name) = show name
    show (UnsafeAsciiHeader  name) = show name
  
  {-------------------------------------------------------------------------------
    Internal auxiliary
  -------------------------------------------------------------------------------}
  
  invalid :: (Show a, HasCallStack) => a -> b
  invalid x = error $ "Invalid: " ++ show x ++ " at "