{-# LANGUAGE OverloadedStrings #-}

-- | Map of t'CustomMetadata', handling joining values
module Network.GRPC.Spec.CustomMetadata.Map (
    CustomMetadataMap -- opaque
    -- * Conversion
  , customMetadataMapFromList
  , customMetadataMapToList
    -- * Construction
  , customMetadataMapInsert
  ) where

import Data.ByteString qualified as Strict (ByteString)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import GHC.Generics (Generic)

import Network.GRPC.Spec.CustomMetadata.Raw

{-------------------------------------------------------------------------------
  Definition
-------------------------------------------------------------------------------}

-- | Map from header names to values
--
-- The gRPC spec mandates
--
-- > Custom-Metadata header 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.
--
-- Internally we don't allow for these duplicates, but instead join the headers
-- as mandated by the spec.
newtype CustomMetadataMap = CustomMetadataMap {
      CustomMetadataMap -> Map HeaderName ByteString
getCustomMetadataMap :: Map HeaderName Strict.ByteString
    }
  deriving stock (Int -> CustomMetadataMap -> ShowS
[CustomMetadataMap] -> ShowS
CustomMetadataMap -> [Char]
(Int -> CustomMetadataMap -> ShowS)
-> (CustomMetadataMap -> [Char])
-> ([CustomMetadataMap] -> ShowS)
-> Show CustomMetadataMap
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomMetadataMap -> ShowS
showsPrec :: Int -> CustomMetadataMap -> ShowS
$cshow :: CustomMetadataMap -> [Char]
show :: CustomMetadataMap -> [Char]
$cshowList :: [CustomMetadataMap] -> ShowS
showList :: [CustomMetadataMap] -> ShowS
Show, CustomMetadataMap -> CustomMetadataMap -> Bool
(CustomMetadataMap -> CustomMetadataMap -> Bool)
-> (CustomMetadataMap -> CustomMetadataMap -> Bool)
-> Eq CustomMetadataMap
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomMetadataMap -> CustomMetadataMap -> Bool
== :: CustomMetadataMap -> CustomMetadataMap -> Bool
$c/= :: CustomMetadataMap -> CustomMetadataMap -> Bool
/= :: CustomMetadataMap -> CustomMetadataMap -> Bool
Eq, (forall x. CustomMetadataMap -> Rep CustomMetadataMap x)
-> (forall x. Rep CustomMetadataMap x -> CustomMetadataMap)
-> Generic CustomMetadataMap
forall x. Rep CustomMetadataMap x -> CustomMetadataMap
forall x. CustomMetadataMap -> Rep CustomMetadataMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CustomMetadataMap -> Rep CustomMetadataMap x
from :: forall x. CustomMetadataMap -> Rep CustomMetadataMap x
$cto :: forall x. Rep CustomMetadataMap x -> CustomMetadataMap
to :: forall x. Rep CustomMetadataMap x -> CustomMetadataMap
Generic)

{-------------------------------------------------------------------------------
  Dealing with duplicates
-------------------------------------------------------------------------------}

instance Monoid CustomMetadataMap where
  mempty :: CustomMetadataMap
mempty = Map HeaderName ByteString -> CustomMetadataMap
CustomMetadataMap Map HeaderName ByteString
forall k a. Map k a
Map.empty

instance Semigroup CustomMetadataMap where
  CustomMetadataMap Map HeaderName ByteString
x <> :: CustomMetadataMap -> CustomMetadataMap -> CustomMetadataMap
<> CustomMetadataMap Map HeaderName ByteString
y = Map HeaderName ByteString -> CustomMetadataMap
CustomMetadataMap (Map HeaderName ByteString -> CustomMetadataMap)
-> Map HeaderName ByteString -> CustomMetadataMap
forall a b. (a -> b) -> a -> b
$
      (ByteString -> ByteString -> ByteString)
-> Map HeaderName ByteString
-> Map HeaderName ByteString
-> Map HeaderName ByteString
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith ByteString -> ByteString -> ByteString
joinHeaderValue Map HeaderName ByteString
x Map HeaderName ByteString
y

{-------------------------------------------------------------------------------
  Conversion
-------------------------------------------------------------------------------}

-- | Construct t'CustomMetadataMap', joining duplicates
customMetadataMapFromList :: [CustomMetadata] -> CustomMetadataMap
customMetadataMapFromList :: [CustomMetadata] -> CustomMetadataMap
customMetadataMapFromList =
      Map HeaderName ByteString -> CustomMetadataMap
CustomMetadataMap
    (Map HeaderName ByteString -> CustomMetadataMap)
-> ([CustomMetadata] -> Map HeaderName ByteString)
-> [CustomMetadata]
-> CustomMetadataMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString -> ByteString)
-> [(HeaderName, ByteString)] -> Map HeaderName ByteString
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith ByteString -> ByteString -> ByteString
joinHeaderValue
    ([(HeaderName, ByteString)] -> Map HeaderName ByteString)
-> ([CustomMetadata] -> [(HeaderName, ByteString)])
-> [CustomMetadata]
-> Map HeaderName ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CustomMetadata -> (HeaderName, ByteString))
-> [CustomMetadata] -> [(HeaderName, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map CustomMetadata -> (HeaderName, ByteString)
unpairCustomMetadata

-- | Flatten t'CustomMetadataMap' to a list
--
-- Precondition: the map must be valid.
customMetadataMapToList :: CustomMetadataMap -> [CustomMetadata]
customMetadataMapToList :: CustomMetadataMap -> [CustomMetadata]
customMetadataMapToList CustomMetadataMap
mds =
      ((HeaderName, ByteString) -> CustomMetadata)
-> [(HeaderName, ByteString)] -> [CustomMetadata]
forall a b. (a -> b) -> [a] -> [b]
map (HeaderName, ByteString) -> CustomMetadata
pairCustomMetadata
    ([(HeaderName, ByteString)] -> [CustomMetadata])
-> (CustomMetadataMap -> [(HeaderName, ByteString)])
-> CustomMetadataMap
-> [CustomMetadata]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map HeaderName ByteString -> [(HeaderName, ByteString)]
forall k a. Map k a -> [(k, a)]
Map.toList
    (Map HeaderName ByteString -> [(HeaderName, ByteString)])
-> (CustomMetadataMap -> Map HeaderName ByteString)
-> CustomMetadataMap
-> [(HeaderName, ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CustomMetadataMap -> Map HeaderName ByteString
getCustomMetadataMap
    (CustomMetadataMap -> [CustomMetadata])
-> CustomMetadataMap -> [CustomMetadata]
forall a b. (a -> b) -> a -> b
$ CustomMetadataMap
mds

{-------------------------------------------------------------------------------
  Construction
-------------------------------------------------------------------------------}

-- | Insert value into t'CustomMetadataMap'
--
-- If a header with the same name already exists, the value is appended to
-- (the end of) the existing value.
customMetadataMapInsert ::
     CustomMetadata
  -> CustomMetadataMap -> CustomMetadataMap
customMetadataMapInsert :: CustomMetadata -> CustomMetadataMap -> CustomMetadataMap
customMetadataMapInsert (CustomMetadata HeaderName
name ByteString
value) (CustomMetadataMap Map HeaderName ByteString
mds) =
    Map HeaderName ByteString -> CustomMetadataMap
CustomMetadataMap (Map HeaderName ByteString -> CustomMetadataMap)
-> Map HeaderName ByteString -> CustomMetadataMap
forall a b. (a -> b) -> a -> b
$
      (ByteString -> ByteString -> ByteString)
-> HeaderName
-> ByteString
-> Map HeaderName ByteString
-> Map HeaderName ByteString
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith ((ByteString -> ByteString -> ByteString)
-> ByteString -> ByteString -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip ByteString -> ByteString -> ByteString
joinHeaderValue) HeaderName
name ByteString
value Map HeaderName ByteString
mds

{-------------------------------------------------------------------------------
  Internal auxiliary
-------------------------------------------------------------------------------}

joinHeaderValue :: Strict.ByteString -> Strict.ByteString -> Strict.ByteString
joinHeaderValue :: ByteString -> ByteString -> ByteString
joinHeaderValue ByteString
x ByteString
y = ByteString
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"," ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
y

unpairCustomMetadata :: CustomMetadata -> (HeaderName, Strict.ByteString)
unpairCustomMetadata :: CustomMetadata -> (HeaderName, ByteString)
unpairCustomMetadata (CustomMetadata HeaderName
name ByteString
value) = (HeaderName
name, ByteString
value)

pairCustomMetadata :: (HeaderName, Strict.ByteString) -> CustomMetadata
pairCustomMetadata :: (HeaderName, ByteString) -> CustomMetadata
pairCustomMetadata (HeaderName, ByteString)
md =
    CustomMetadata -> Maybe CustomMetadata -> CustomMetadata
forall a. a -> Maybe a -> a
fromMaybe ([Char] -> CustomMetadata
forall a. HasCallStack => [Char] -> a
error ([Char] -> CustomMetadata) -> [Char] -> CustomMetadata
forall a b. (a -> b) -> a -> b
$ [Char]
"invalid " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ (HeaderName, ByteString) -> [Char]
forall a. Show a => a -> [Char]
show (HeaderName, ByteString)
md) (Maybe CustomMetadata -> CustomMetadata)
-> Maybe CustomMetadata -> CustomMetadata
forall a b. (a -> b) -> a -> b
$
      (HeaderName -> ByteString -> Maybe CustomMetadata)
-> (HeaderName, ByteString) -> Maybe CustomMetadata
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry HeaderName -> ByteString -> Maybe CustomMetadata
safeCustomMetadata (HeaderName, ByteString)
md