{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE TemplateHaskell #-}

-----------------------------------------------------------------------------

-----------------------------------------------------------------------------

{- |
 Module      :  OpenTelemetry.Baggage
 Copyright   :  (c) Ian Duncan, 2021
 License     :  BSD-3
 Description :  Serializable annotations to add user-defined values to telemetry
 Maintainer  :  Ian Duncan
 Stability   :  experimental
 Portability :  non-portable (GHC extensions)

 Baggage is used to annotate telemetry, adding context and information to metrics, traces, and logs.
 It is a set of name/value pairs describing user-defined properties.

 Note: if you are trying to add data annotations specific to a single trace span, you should use
 'OpenTelemetry.Trace.addAttribute' and 'OpenTelemetry.Trace.addAttributes'
-}
module OpenTelemetry.Baggage (
  -- * Constructing 'Baggage' structures
  Baggage,
  empty,
  fromHashMap,
  values,
  Token,
  token,
  mkToken,
  tokenValue,
  Element (..),
  element,
  property,
  InvalidBaggage (..),

  -- * Modifying 'Baggage'
  insert,
  delete,

  -- * Encoding and decoding 'Baggage'
  encodeBaggageHeader,
  encodeBaggageHeaderB,
  decodeBaggageHeader,
  decodeBaggageHeaderP,
) where

import Control.Applicative hiding (empty)
import qualified Data.Attoparsec.ByteString.Char8 as P
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Builder.Extra as BS
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Unsafe (unsafePackAddressLen)
import Data.CharSet (CharSet)
import qualified Data.CharSet as C
import qualified Data.HashMap.Strict as H
import Data.Hashable
import Data.List (intersperse)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Quote
import Language.Haskell.TH.Syntax
import Network.HTTP.Types.URI
import System.IO.Unsafe


{- | A key for a baggage entry, restricted to the set of valid characters
 specified in the @token@ definition of RFC 2616:

 https://www.rfc-editor.org/rfc/rfc2616#section-2.2
-}
newtype Token = Token ByteString
  deriving stock (Int -> Token -> ShowS
[Token] -> ShowS
Token -> String
(Int -> Token -> ShowS)
-> (Token -> String) -> ([Token] -> ShowS) -> Show Token
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Token -> ShowS
showsPrec :: Int -> Token -> ShowS
$cshow :: Token -> String
show :: Token -> String
$cshowList :: [Token] -> ShowS
showList :: [Token] -> ShowS
Show, Token -> Token -> Bool
(Token -> Token -> Bool) -> (Token -> Token -> Bool) -> Eq Token
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Token -> Token -> Bool
== :: Token -> Token -> Bool
$c/= :: Token -> Token -> Bool
/= :: Token -> Token -> Bool
Eq, Eq Token
Eq Token =>
(Token -> Token -> Ordering)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Bool)
-> (Token -> Token -> Token)
-> (Token -> Token -> Token)
-> Ord Token
Token -> Token -> Bool
Token -> Token -> Ordering
Token -> Token -> Token
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 :: Token -> Token -> Ordering
compare :: Token -> Token -> Ordering
$c< :: Token -> Token -> Bool
< :: Token -> Token -> Bool
$c<= :: Token -> Token -> Bool
<= :: Token -> Token -> Bool
$c> :: Token -> Token -> Bool
> :: Token -> Token -> Bool
$c>= :: Token -> Token -> Bool
>= :: Token -> Token -> Bool
$cmax :: Token -> Token -> Token
max :: Token -> Token -> Token
$cmin :: Token -> Token -> Token
min :: Token -> Token -> Token
Ord)
  deriving newtype (Eq Token
Eq Token =>
(Int -> Token -> Int) -> (Token -> Int) -> Hashable Token
Int -> Token -> Int
Token -> Int
forall a. Eq a => (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> Token -> Int
hashWithSalt :: Int -> Token -> Int
$chash :: Token -> Int
hash :: Token -> Int
Hashable)


-- | Convert a 'Token' into a 'ByteString'
tokenValue :: Token -> ByteString
tokenValue :: Token -> ByteString
tokenValue (Token ByteString
t) = ByteString
t

#if MIN_VERSION_template_haskell(2, 17, 0)
instance Lift Token where
  liftTyped :: forall (m :: * -> *). Quote m => Token -> Code m Token
liftTyped (Token ByteString
tok) = m (TExp Token) -> Code m Token
forall a (m :: * -> *). m (TExp a) -> Code m a
liftCode (m (TExp Token) -> Code m Token) -> m (TExp Token) -> Code m Token
forall a b. (a -> b) -> a -> b
$ m Exp -> m (TExp Token)
forall a (m :: * -> *). Quote m => m Exp -> m (TExp a)
unsafeTExpCoerce (m Exp -> m (TExp Token)) -> m Exp -> m (TExp Token)
forall a b. (a -> b) -> a -> b
$ ByteString -> m Exp
forall (m :: * -> *). Monad m => ByteString -> m Exp
bsToExp ByteString
tok
#else
instance Lift Token where
  liftTyped (Token tok) = unsafeTExpCoerce $ bsToExp tok
#endif


-- | An entry into the baggage
data Element = Element
  { Element -> Text
value :: Text
  , Element -> [Property]
properties :: [Property]
  }
  deriving stock (Int -> Element -> ShowS
[Element] -> ShowS
Element -> String
(Int -> Element -> ShowS)
-> (Element -> String) -> ([Element] -> ShowS) -> Show Element
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Element -> ShowS
showsPrec :: Int -> Element -> ShowS
$cshow :: Element -> String
show :: Element -> String
$cshowList :: [Element] -> ShowS
showList :: [Element] -> ShowS
Show, Element -> Element -> Bool
(Element -> Element -> Bool)
-> (Element -> Element -> Bool) -> Eq Element
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Element -> Element -> Bool
== :: Element -> Element -> Bool
$c/= :: Element -> Element -> Bool
/= :: Element -> Element -> Bool
Eq)


element :: Text -> Element
element :: Text -> Element
element Text
t = Text -> [Property] -> Element
Element Text
t []


data Property = Property
  { Property -> Token
propertyKey :: Token
  , Property -> Maybe Text
propertyValue :: Maybe Text
  }
  deriving stock (Int -> Property -> ShowS
[Property] -> ShowS
Property -> String
(Int -> Property -> ShowS)
-> (Property -> String) -> ([Property] -> ShowS) -> Show Property
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Property -> ShowS
showsPrec :: Int -> Property -> ShowS
$cshow :: Property -> String
show :: Property -> String
$cshowList :: [Property] -> ShowS
showList :: [Property] -> ShowS
Show, Property -> Property -> Bool
(Property -> Property -> Bool)
-> (Property -> Property -> Bool) -> Eq Property
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Property -> Property -> Bool
== :: Property -> Property -> Bool
$c/= :: Property -> Property -> Bool
/= :: Property -> Property -> Bool
Eq)


property :: Token -> Maybe Text -> Property
property :: Token -> Maybe Text -> Property
property = Token -> Maybe Text -> Property
Property


{- | Baggage is used to annotate telemetry, adding context and information to metrics, traces, and logs.
 It is a set of name/value pairs describing user-defined properties.
 Each name in Baggage is associated with exactly one value.
-}
newtype Baggage = Baggage (H.HashMap Token Element)
  deriving stock (Int -> Baggage -> ShowS
[Baggage] -> ShowS
Baggage -> String
(Int -> Baggage -> ShowS)
-> (Baggage -> String) -> ([Baggage] -> ShowS) -> Show Baggage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Baggage -> ShowS
showsPrec :: Int -> Baggage -> ShowS
$cshow :: Baggage -> String
show :: Baggage -> String
$cshowList :: [Baggage] -> ShowS
showList :: [Baggage] -> ShowS
Show, Baggage -> Baggage -> Bool
(Baggage -> Baggage -> Bool)
-> (Baggage -> Baggage -> Bool) -> Eq Baggage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Baggage -> Baggage -> Bool
== :: Baggage -> Baggage -> Bool
$c/= :: Baggage -> Baggage -> Bool
/= :: Baggage -> Baggage -> Bool
Eq)
  deriving newtype (NonEmpty Baggage -> Baggage
Baggage -> Baggage -> Baggage
(Baggage -> Baggage -> Baggage)
-> (NonEmpty Baggage -> Baggage)
-> (forall b. Integral b => b -> Baggage -> Baggage)
-> Semigroup Baggage
forall b. Integral b => b -> Baggage -> Baggage
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: Baggage -> Baggage -> Baggage
<> :: Baggage -> Baggage -> Baggage
$csconcat :: NonEmpty Baggage -> Baggage
sconcat :: NonEmpty Baggage -> Baggage
$cstimes :: forall b. Integral b => b -> Baggage -> Baggage
stimes :: forall b. Integral b => b -> Baggage -> Baggage
Semigroup)


tokenCharacters :: CharSet
tokenCharacters :: CharSet
tokenCharacters = String -> CharSet
C.fromList String
"!#$%&'*+-.^_`|~0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"


-- Ripped from file-embed-0.0.13
bsToExp :: (Monad m) => ByteString -> m Exp
#if MIN_VERSION_template_haskell(2, 5, 0)
bsToExp :: forall (m :: * -> *). Monad m => ByteString -> m Exp
bsToExp ByteString
bs =
    Exp -> m Exp
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Exp -> m Exp) -> Exp -> m Exp
forall a b. (a -> b) -> a -> b
$ Name -> Exp
ConE 'Token
      Exp -> Exp -> Exp
`AppE` (Name -> Exp
VarE 'unsafePerformIO
      Exp -> Exp -> Exp
`AppE` (Name -> Exp
VarE 'unsafePackAddressLen
      Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (Integer -> Lit
IntegerL (Integer -> Lit) -> Integer -> Lit
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
bs)
#if MIN_VERSION_template_haskell(2, 16, 0)
      Exp -> Exp -> Exp
`AppE` Lit -> Exp
LitE (Bytes -> Lit
bytesPrimL (
                let BS.PS ForeignPtr Word8
ptr Int
off Int
sz = ByteString
bs
                in  ForeignPtr Word8 -> Word -> Word -> Bytes
mkBytes ForeignPtr Word8
ptr (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
off) (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)))))
#elif MIN_VERSION_template_haskell(2, 8, 0)
      `AppE` LitE (StringPrimL $ B.unpack bs)))
#else
      `AppE` LitE (StringPrimL $ B8.unpack bs)))
#endif
#else
bsToExp bs = do
    helper <- [| stringToBs |]
    let chars = B8.unpack bs
    return $! AppE helper $! LitE $! StringL chars
#endif


mkToken :: Text -> Maybe Token
mkToken :: Text -> Maybe Token
mkToken Text
txt
  | Text
txt Text -> Int -> Ordering
`T.compareLength` Int
4096 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT = Maybe Token
forall a. Maybe a
Nothing
  | (Char -> Bool) -> Text -> Bool
T.all (Char -> CharSet -> Bool
`C.member` CharSet
tokenCharacters) Text
txt = Token -> Maybe Token
forall a. a -> Maybe a
Just (Token -> Maybe Token) -> Token -> Maybe Token
forall a b. (a -> b) -> a -> b
$ ByteString -> Token
Token (ByteString -> Token) -> ByteString -> Token
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
txt
  | Bool
otherwise = Maybe Token
forall a. Maybe a
Nothing


token :: QuasiQuoter
token :: QuasiQuoter
token =
  QuasiQuoter
    { quoteExp :: String -> Q Exp
quoteExp = String -> Q Exp
parseExp
    , quotePat :: String -> Q Pat
quotePat = \String
_ -> String -> Q Pat
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Token as pattern not implemented"
    , quoteType :: String -> Q Type
quoteType = \String
_ -> String -> Q Type
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't use a Baggage Token as a type"
    , quoteDec :: String -> Q [Dec]
quoteDec = \String
_ -> String -> Q [Dec]
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can't use a Baggage Token as a declaration"
    }
  where
    parseExp :: String -> Q Exp
parseExp = \String
str -> case Text -> Maybe Token
mkToken (Text -> Maybe Token) -> Text -> Maybe Token
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
str of
      Maybe Token
Nothing -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (ShowS
forall a. Show a => a -> String
show String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a valid Token.")
      Just Token
tok -> Token -> Q Exp
forall t (m :: * -> *). (Lift t, Quote m) => t -> m Exp
forall (m :: * -> *). Quote m => Token -> m Exp
lift Token
tok


data InvalidBaggage
  = BaggageTooLong
  | MemberTooLong
  | TooManyListMembers
  | Empty


-- TODO: The fact that this can be a max of 8192 bytes
-- should allow this to optimized pretty heavily
encodeBaggageHeader :: Baggage -> ByteString
encodeBaggageHeader :: Baggage -> ByteString
encodeBaggageHeader =
  ByteString -> ByteString
L.toStrict
    (ByteString -> ByteString)
-> (Baggage -> ByteString) -> Baggage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllocationStrategy -> ByteString -> Builder -> ByteString
BS.toLazyByteStringWith (Int -> Int -> AllocationStrategy
BS.untrimmedStrategy (Int
8192 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
16) Int
BS.smallChunkSize) ByteString
L.empty
    (Builder -> ByteString)
-> (Baggage -> Builder) -> Baggage -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> Builder
encodeBaggageHeaderB


encodeBaggageHeaderB :: Baggage -> B.Builder
encodeBaggageHeaderB :: Baggage -> Builder
encodeBaggageHeaderB (Baggage HashMap Token Element
bmap) =
  [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$
    Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
B.char7 Char
',') ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$
      ((Token, Element) -> Builder) -> [(Token, Element)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Token, Element) -> Builder
go ([(Token, Element)] -> [Builder])
-> [(Token, Element)] -> [Builder]
forall a b. (a -> b) -> a -> b
$
        HashMap Token Element -> [(Token, Element)]
forall k v. HashMap k v -> [(k, v)]
H.toList HashMap Token Element
bmap
  where
    go :: (Token, Element) -> Builder
go (Token ByteString
k, Element Text
v [Property]
props) =
      ByteString -> Builder
B.byteString ByteString
k
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
B.char7 Char
'='
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> ByteString -> Builder
urlEncodeBuilder Bool
False (Text -> ByteString
encodeUtf8 Text
v)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ([Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder) -> [Builder] -> Builder
forall a b. (a -> b) -> a -> b
$ Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Char -> Builder
B.char7 Char
';') ([Builder] -> [Builder]) -> [Builder] -> [Builder]
forall a b. (a -> b) -> a -> b
$ (Property -> Builder) -> [Property] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map Property -> Builder
propEncoder [Property]
props)
    propEncoder :: Property -> Builder
propEncoder (Property (Token ByteString
k) Maybe Text
mv) =
      ByteString -> Builder
B.byteString ByteString
k
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder -> (Text -> Builder) -> Maybe Text -> Builder
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
          Builder
forall a. Monoid a => a
mempty
          (\Text
v -> Char -> Builder
B.char7 Char
'=' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> ByteString -> Builder
urlEncodeBuilder Bool
False (Text -> ByteString
encodeUtf8 Text
v))
          Maybe Text
mv


decodeBaggageHeader :: ByteString -> Either String Baggage
decodeBaggageHeader :: ByteString -> Either String Baggage
decodeBaggageHeader = Parser Baggage -> ByteString -> Either String Baggage
forall a. Parser a -> ByteString -> Either String a
P.parseOnly Parser Baggage
decodeBaggageHeaderP


decodeBaggageHeaderP :: P.Parser Baggage
decodeBaggageHeaderP :: Parser Baggage
decodeBaggageHeaderP = do
  Parser ()
owsP
  (Token, Element)
firstMember <- Parser (Token, Element)
memberP
  [(Token, Element)]
otherMembers <- Parser (Token, Element) -> Parser ByteString [(Token, Element)]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ()
owsP Parser () -> Parser ByteString Word8 -> Parser ByteString Word8
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser ByteString Word8
P.char8 Char
',' Parser ByteString Word8 -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
owsP Parser () -> Parser (Token, Element) -> Parser (Token, Element)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Token, Element)
memberP)
  Parser ()
owsP
  Baggage -> Parser Baggage
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Baggage -> Parser Baggage) -> Baggage -> Parser Baggage
forall a b. (a -> b) -> a -> b
$ HashMap Token Element -> Baggage
Baggage (HashMap Token Element -> Baggage)
-> HashMap Token Element -> Baggage
forall a b. (a -> b) -> a -> b
$ [(Token, Element)] -> HashMap Token Element
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
H.fromList ((Token, Element)
firstMember (Token, Element) -> [(Token, Element)] -> [(Token, Element)]
forall a. a -> [a] -> [a]
: [(Token, Element)]
otherMembers)
  where
    owsSet :: CharSet
owsSet = String -> CharSet
C.fromList String
" \t"
    owsP :: Parser ()
owsP = (Char -> Bool) -> Parser ()
P.skipWhile (Char -> CharSet -> Bool
`C.member` CharSet
owsSet)
    memberP :: P.Parser (Token, Element)
    memberP :: Parser (Token, Element)
memberP = do
      Token
tok <- Parser Token
tokenP
      Parser ()
owsP
      Word8
_ <- Char -> Parser ByteString Word8
P.char8 Char
'='
      Parser ()
owsP
      Text
val <- Parser ByteString Text
valP
      [Property]
props <- Parser ByteString Property -> Parser ByteString [Property]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ()
owsP Parser () -> Parser ByteString Word8 -> Parser ByteString Word8
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Char -> Parser ByteString Word8
P.char8 Char
';' Parser ByteString Word8 -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
owsP Parser ()
-> Parser ByteString Property -> Parser ByteString Property
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ByteString Property
propertyP)
      (Token, Element) -> Parser (Token, Element)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Token
tok, Text -> [Property] -> Element
Element Text
val [Property]
props)
    valueSet :: CharSet
valueSet =
      String -> CharSet
C.fromList (String -> CharSet) -> String -> CharSet
forall a b. (a -> b) -> a -> b
$
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ [Char
'\x21']
          , [Char
'\x23' .. Char
'\x2B']
          , [Char
'\x2D' .. Char
'\x3A']
          , [Char
'\x3C' .. Char
'\x5B']
          , [Char
'\x5D' .. Char
'\x7E']
          ]
    tokenP :: P.Parser Token
    tokenP :: Parser Token
tokenP = ByteString -> Token
Token (ByteString -> Token)
-> Parser ByteString ByteString -> Parser Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
P.takeWhile1 (Char -> CharSet -> Bool
`C.member` CharSet
tokenCharacters)
    valP :: Parser ByteString Text
valP = ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> ByteString -> ByteString
urlDecode Bool
False (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
P.takeWhile (Char -> CharSet -> Bool
`C.member` CharSet
valueSet)
    propertyP :: P.Parser Property
    propertyP :: Parser ByteString Property
propertyP = do
      Token
key <- Parser Token
tokenP
      Parser ()
owsP
      Maybe Text
val <- Maybe Text
-> Parser ByteString (Maybe Text) -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
P.option Maybe Text
forall a. Maybe a
Nothing (Parser ByteString (Maybe Text) -> Parser ByteString (Maybe Text))
-> Parser ByteString (Maybe Text) -> Parser ByteString (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
        Word8
_ <- Char -> Parser ByteString Word8
P.char8 Char
'='
        Parser ()
owsP
        Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text)
-> Parser ByteString Text -> Parser ByteString (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
valP
      Property -> Parser ByteString Property
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Property -> Parser ByteString Property)
-> Property -> Parser ByteString Property
forall a b. (a -> b) -> a -> b
$ Token -> Maybe Text -> Property
Property Token
key Maybe Text
val


-- | An empty initial baggage value
empty :: Baggage
empty :: Baggage
empty = HashMap Token Element -> Baggage
Baggage HashMap Token Element
forall k v. HashMap k v
H.empty


insert
  :: Token
  -- ^ The name for which to set the value
  -> Element
  -- ^ The value to set. Use 'element' to construct a well-formed element value.
  -> Baggage
  -> Baggage
insert :: Token -> Element -> Baggage -> Baggage
insert Token
k Element
v (Baggage HashMap Token Element
c) = HashMap Token Element -> Baggage
Baggage (Token -> Element -> HashMap Token Element -> HashMap Token Element
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
H.insert Token
k Element
v HashMap Token Element
c)


-- | Delete a key/value pair from the baggage.
delete :: Token -> Baggage -> Baggage
delete :: Token -> Baggage -> Baggage
delete Token
k (Baggage HashMap Token Element
c) = HashMap Token Element -> Baggage
Baggage (Token -> HashMap Token Element -> HashMap Token Element
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
H.delete Token
k HashMap Token Element
c)


{- | Returns the name/value pairs in the `Baggage`. The order of name/value pairs
 is not significant.

 @since 0.0.1.0
-}
values :: Baggage -> H.HashMap Token Element
values :: Baggage -> HashMap Token Element
values (Baggage HashMap Token Element
m) = HashMap Token Element
m


-- | Convert a 'H.HashMap' into 'Baggage'
fromHashMap :: H.HashMap Token Element -> Baggage
fromHashMap :: HashMap Token Element -> Baggage
fromHashMap = HashMap Token Element -> Baggage
Baggage