{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module OTel.API.Baggage.Core.Internal
  ( -- * Disclaimer
    -- $disclaimer
    MonadBaggage(..)

  , Baggage(..)
  , nullBaggage
  , sizeBaggage
  , memberBaggage
  , lookupBaggage
  , findWithDefaultBaggage
  , deleteBaggage
  , filterBaggage
  , filterWithKeyBaggage
  , foldMapWithKeyBaggage
  , toListBaggage

  , BaggageBuilder(..)
  , buildBaggage
  , buildBaggagePure

  , contextBackendBaggage
  , contextKeyBaggage

  , isRFC7230TokenChar
  , isRFC7230VCHARChar
  ) where

#if MIN_VERSION_base(4,18,0)
import Control.Applicative ()
#else
import Control.Applicative (Applicative(..))
#endif

import Control.Exception.Safe (MonadThrow, throwM)
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.IO.Unlift (MonadUnliftIO(withRunInIO))
import Control.Monad.Logger (LoggingT)
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Monad.Trans.Control (MonadTransControl(liftWith, restoreT))
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Identity (IdentityT(..))
import Control.Monad.Trans.Maybe (MaybeT)
import Control.Monad.Trans.Reader (ReaderT(..))
import Control.Monad.Trans.Resource (ResourceT)
import Data.Bifunctor (Bifunctor(..))
import Data.DList (DList)
import Data.HashMap.Strict (HashMap)
import Data.Monoid (Ap(..))
import Data.Text (Text)
import OTel.API.Baggage.Core.Builder.Errors
  ( BaggageError(..), BaggageErrors(..), BaggageKeyContainsInvalidCharsError(..)
  , BaggageKeyIsEmptyError(..), BaggageValueContainsInvalidCharsError(..)
  , BaggageValueIsEmptyError(..)
  )
import OTel.API.Context.Core (ContextBackend, ContextKey)
import OTel.API.Context.Core.Internal (contextBackendValueKey, unsafeNewContextBackend)
import OTel.API.Common (KV(..), Key(..), IsTextKV)
import Prelude
import System.IO.Unsafe (unsafePerformIO)
import qualified Control.Monad.Trans.RWS.Lazy as RWS.Lazy
import qualified Control.Monad.Trans.RWS.Strict as RWS.Strict
import qualified Control.Monad.Trans.State.Lazy as State.Lazy
import qualified Control.Monad.Trans.State.Strict as State.Strict
import qualified Control.Monad.Trans.Writer.Lazy as Writer.Lazy
import qualified Control.Monad.Trans.Writer.Strict as Writer.Strict
import qualified Data.Char as Char
import qualified Data.DList as DList
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Text as Text

class (Monad m) => MonadBaggage m where
  getBaggage :: m Baggage
  setBaggage :: Baggage -> m a -> m a

  default getBaggage
    :: (MonadTrans t, MonadBaggage n, m ~ t n)
    => m Baggage
  getBaggage = n Baggage -> t n Baggage
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift n Baggage
forall (m :: * -> *). MonadBaggage m => m Baggage
getBaggage

  default setBaggage
    :: (MonadTransControl t, MonadBaggage n, m ~ t n)
    => Baggage
    -> m a
    -> m a
  setBaggage Baggage
baggage m a
action =
    n (StT t a) -> m a
n (StT t a) -> t n a
forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
m (StT t a) -> t m a
restoreT (n (StT t a) -> m a) -> (StT t a -> n (StT t a)) -> StT t a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StT t a -> n (StT t a)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (StT t a -> m a) -> m (StT t a) -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Run t -> n (StT t a)) -> t n (StT t a)
forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTransControl t, Monad m) =>
(Run t -> m a) -> t m a
liftWith \Run t
run -> Baggage -> n (StT t a) -> n (StT t a)
forall a. Baggage -> n a -> n a
forall (m :: * -> *) a. MonadBaggage m => Baggage -> m a -> m a
setBaggage Baggage
baggage (t n a -> n (StT t a)
Run t
run m a
t n a
action)

instance (MonadBaggage m) => MonadBaggage (ExceptT e m)
instance (MonadBaggage m) => MonadBaggage (IdentityT m)
instance (MonadBaggage m) => MonadBaggage (MaybeT m)
instance (MonadBaggage m) => MonadBaggage (ReaderT r m)
instance (MonadBaggage m) => MonadBaggage (State.Lazy.StateT r m)
instance (MonadBaggage m) => MonadBaggage (State.Strict.StateT r m)
instance (MonadBaggage m, Monoid w) => MonadBaggage (RWS.Lazy.RWST r w s m)
instance (MonadBaggage m, Monoid w) => MonadBaggage (RWS.Strict.RWST r w s m)
instance (MonadBaggage m, Monoid w) => MonadBaggage (Writer.Lazy.WriterT w m)
instance (MonadBaggage m, Monoid w) => MonadBaggage (Writer.Strict.WriterT w m)
instance (MonadBaggage m) => MonadBaggage (LoggingT m)
instance (MonadBaggage m, MonadUnliftIO m) => MonadBaggage (ResourceT m) where
  setBaggage :: forall a. Baggage -> ResourceT m a -> ResourceT m a
setBaggage Baggage
baggage ResourceT m a
action = do
    ((forall a. ResourceT m a -> IO a) -> IO a) -> ResourceT m a
forall b.
((forall a. ResourceT m a -> IO a) -> IO b) -> ResourceT m b
forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO \forall a. ResourceT m a -> IO a
runInIO -> do
      ResourceT m a -> IO a
forall a. ResourceT m a -> IO a
runInIO (ResourceT m a -> IO a) -> ResourceT m a -> IO a
forall a b. (a -> b) -> a -> b
$ Baggage -> ResourceT m a -> ResourceT m a
forall a. Baggage -> ResourceT m a -> ResourceT m a
forall (m :: * -> *) a. MonadBaggage m => Baggage -> m a -> m a
setBaggage Baggage
baggage ResourceT m a
action

newtype Baggage = Baggage
  { Baggage -> HashMap Text Text
unBaggage :: HashMap Text Text
  } deriving stock (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, 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)
    deriving (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, Semigroup Baggage
Baggage
Semigroup Baggage =>
Baggage
-> (Baggage -> Baggage -> Baggage)
-> ([Baggage] -> Baggage)
-> Monoid Baggage
[Baggage] -> Baggage
Baggage -> Baggage -> Baggage
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: Baggage
mempty :: Baggage
$cmappend :: Baggage -> Baggage -> Baggage
mappend :: Baggage -> Baggage -> Baggage
$cmconcat :: [Baggage] -> Baggage
mconcat :: [Baggage] -> Baggage
Monoid) via (HashMap Text Text)

nullBaggage :: Baggage -> Bool
nullBaggage :: Baggage -> Bool
nullBaggage = HashMap Text Text -> Bool
forall k v. HashMap k v -> Bool
HashMap.null (HashMap Text Text -> Bool)
-> (Baggage -> HashMap Text Text) -> Baggage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> HashMap Text Text
unBaggage

sizeBaggage :: Baggage -> Int
sizeBaggage :: Baggage -> Int
sizeBaggage = HashMap Text Text -> Int
forall k v. HashMap k v -> Int
HashMap.size (HashMap Text Text -> Int)
-> (Baggage -> HashMap Text Text) -> Baggage -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> HashMap Text Text
unBaggage

memberBaggage :: Key Text -> Baggage -> Bool
memberBaggage :: Key Text -> Baggage -> Bool
memberBaggage Key Text
key = Text -> HashMap Text Text -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member (Key Text -> Text
forall a. Key a -> Text
unKey Key Text
key) (HashMap Text Text -> Bool)
-> (Baggage -> HashMap Text Text) -> Baggage -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> HashMap Text Text
unBaggage

lookupBaggage :: Key Text -> Baggage -> Maybe Text
lookupBaggage :: Key Text -> Baggage -> Maybe Text
lookupBaggage Key Text
key = Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup (Key Text -> Text
forall a. Key a -> Text
unKey Key Text
key) (HashMap Text Text -> Maybe Text)
-> (Baggage -> HashMap Text Text) -> Baggage -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> HashMap Text Text
unBaggage

findWithDefaultBaggage :: Text -> Key Text -> Baggage -> Text
findWithDefaultBaggage :: Text -> Key Text -> Baggage -> Text
findWithDefaultBaggage Text
defVal Key Text
key =
  Text -> Text -> HashMap Text Text -> Text
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
HashMap.findWithDefault Text
defVal (Key Text -> Text
forall a. Key a -> Text
unKey Key Text
key) (HashMap Text Text -> Text)
-> (Baggage -> HashMap Text Text) -> Baggage -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> HashMap Text Text
unBaggage

deleteBaggage :: Key Text -> Baggage -> Baggage
deleteBaggage :: Key Text -> Baggage -> Baggage
deleteBaggage Key Text
key = HashMap Text Text -> Baggage
Baggage (HashMap Text Text -> Baggage)
-> (Baggage -> HashMap Text Text) -> Baggage -> Baggage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> HashMap Text Text -> HashMap Text Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> HashMap k v
HashMap.delete (Key Text -> Text
forall a. Key a -> Text
unKey Key Text
key) (HashMap Text Text -> HashMap Text Text)
-> (Baggage -> HashMap Text Text) -> Baggage -> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> HashMap Text Text
unBaggage

filterBaggage :: (Text -> Bool) -> Baggage -> Baggage
filterBaggage :: (Text -> Bool) -> Baggage -> Baggage
filterBaggage Text -> Bool
f = HashMap Text Text -> Baggage
Baggage (HashMap Text Text -> Baggage)
-> (Baggage -> HashMap Text Text) -> Baggage -> Baggage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Bool) -> HashMap Text Text -> HashMap Text Text
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filter Text -> Bool
f (HashMap Text Text -> HashMap Text Text)
-> (Baggage -> HashMap Text Text) -> Baggage -> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> HashMap Text Text
unBaggage

filterWithKeyBaggage :: (Key Text -> Text -> Bool) -> Baggage -> Baggage
filterWithKeyBaggage :: (Key Text -> Text -> Bool) -> Baggage -> Baggage
filterWithKeyBaggage Key Text -> Text -> Bool
f = HashMap Text Text -> Baggage
Baggage (HashMap Text Text -> Baggage)
-> (Baggage -> HashMap Text Text) -> Baggage -> Baggage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text -> Bool) -> HashMap Text Text -> HashMap Text Text
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey Text -> Text -> Bool
f' (HashMap Text Text -> HashMap Text Text)
-> (Baggage -> HashMap Text Text) -> Baggage -> HashMap Text Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> HashMap Text Text
unBaggage
  where
  f' :: Text -> Text -> Bool
f' Text
keyText Text
val = Key Text -> Text -> Bool
f (Text -> Key Text
forall a. Text -> Key a
Key Text
keyText) Text
val

foldMapWithKeyBaggage
  :: forall m
   . (Monoid m)
  => (Key Text -> Text -> m)
  -> Baggage
  -> m
foldMapWithKeyBaggage :: forall m. Monoid m => (Key Text -> Text -> m) -> Baggage -> m
foldMapWithKeyBaggage Key Text -> Text -> m
f Baggage
baggage =
  ((Text -> Text -> m) -> HashMap Text Text -> m)
-> HashMap Text Text -> (Text -> Text -> m) -> m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> Text -> m) -> HashMap Text Text -> m
forall m k v. Monoid m => (k -> v -> m) -> HashMap k v -> m
HashMap.foldMapWithKey (Baggage -> HashMap Text Text
unBaggage Baggage
baggage) \Text
keyText Text
val ->
    Key Text -> Text -> m
f (Text -> Key Text
forall a. Text -> Key a
Key Text
keyText) Text
val

toListBaggage :: Baggage -> [(Key Text, Text)]
toListBaggage :: Baggage -> [(Key Text, Text)]
toListBaggage Baggage
baggage = (Key Text -> Text -> [(Key Text, Text)] -> [(Key Text, Text)])
-> Baggage -> [(Key Text, Text)] -> [(Key Text, Text)]
forall m. Monoid m => (Key Text -> Text -> m) -> Baggage -> m
foldMapWithKeyBaggage (\Key Text
k Text
v -> ((Key Text
k, Text
v) (Key Text, Text) -> [(Key Text, Text)] -> [(Key Text, Text)]
forall a. a -> [a] -> [a]
:)) Baggage
baggage []

newtype BaggageBuilder a = BaggageBuilder
  { forall a. BaggageBuilder a -> Either (DList BaggageError) a
unBaggageBuilder :: Either (DList BaggageError) a
  } deriving
      ( (forall a b. (a -> b) -> BaggageBuilder a -> BaggageBuilder b)
-> (forall a b. a -> BaggageBuilder b -> BaggageBuilder a)
-> Functor BaggageBuilder
forall a b. a -> BaggageBuilder b -> BaggageBuilder a
forall a b. (a -> b) -> BaggageBuilder a -> BaggageBuilder b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> BaggageBuilder a -> BaggageBuilder b
fmap :: forall a b. (a -> b) -> BaggageBuilder a -> BaggageBuilder b
$c<$ :: forall a b. a -> BaggageBuilder b -> BaggageBuilder a
<$ :: forall a b. a -> BaggageBuilder b -> BaggageBuilder a
Functor -- @base@
      ) via (Either (DList BaggageError))
    deriving
      ( NonEmpty (BaggageBuilder a) -> BaggageBuilder a
BaggageBuilder a -> BaggageBuilder a -> BaggageBuilder a
(BaggageBuilder a -> BaggageBuilder a -> BaggageBuilder a)
-> (NonEmpty (BaggageBuilder a) -> BaggageBuilder a)
-> (forall b.
    Integral b =>
    b -> BaggageBuilder a -> BaggageBuilder a)
-> Semigroup (BaggageBuilder a)
forall b. Integral b => b -> BaggageBuilder a -> BaggageBuilder a
forall a.
Semigroup a =>
NonEmpty (BaggageBuilder a) -> BaggageBuilder a
forall a.
Semigroup a =>
BaggageBuilder a -> BaggageBuilder a -> BaggageBuilder a
forall a b.
(Semigroup a, Integral b) =>
b -> BaggageBuilder a -> BaggageBuilder a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall a.
Semigroup a =>
BaggageBuilder a -> BaggageBuilder a -> BaggageBuilder a
<> :: BaggageBuilder a -> BaggageBuilder a -> BaggageBuilder a
$csconcat :: forall a.
Semigroup a =>
NonEmpty (BaggageBuilder a) -> BaggageBuilder a
sconcat :: NonEmpty (BaggageBuilder a) -> BaggageBuilder a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> BaggageBuilder a -> BaggageBuilder a
stimes :: forall b. Integral b => b -> BaggageBuilder a -> BaggageBuilder a
Semigroup, Semigroup (BaggageBuilder a)
BaggageBuilder a
Semigroup (BaggageBuilder a) =>
BaggageBuilder a
-> (BaggageBuilder a -> BaggageBuilder a -> BaggageBuilder a)
-> ([BaggageBuilder a] -> BaggageBuilder a)
-> Monoid (BaggageBuilder a)
[BaggageBuilder a] -> BaggageBuilder a
BaggageBuilder a -> BaggageBuilder a -> BaggageBuilder a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (BaggageBuilder a)
forall a. Monoid a => BaggageBuilder a
forall a. Monoid a => [BaggageBuilder a] -> BaggageBuilder a
forall a.
Monoid a =>
BaggageBuilder a -> BaggageBuilder a -> BaggageBuilder a
$cmempty :: forall a. Monoid a => BaggageBuilder a
mempty :: BaggageBuilder a
$cmappend :: forall a.
Monoid a =>
BaggageBuilder a -> BaggageBuilder a -> BaggageBuilder a
mappend :: BaggageBuilder a -> BaggageBuilder a -> BaggageBuilder a
$cmconcat :: forall a. Monoid a => [BaggageBuilder a] -> BaggageBuilder a
mconcat :: [BaggageBuilder a] -> BaggageBuilder a
Monoid -- @base@
      ) via (Ap BaggageBuilder a)

instance Applicative BaggageBuilder where
  pure :: forall a. a -> BaggageBuilder a
pure = Either (DList BaggageError) a -> BaggageBuilder a
forall a. Either (DList BaggageError) a -> BaggageBuilder a
BaggageBuilder (Either (DList BaggageError) a -> BaggageBuilder a)
-> (a -> Either (DList BaggageError) a) -> a -> BaggageBuilder a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either (DList BaggageError) a
forall a b. b -> Either a b
Right
  liftA2 :: forall a b c.
(a -> b -> c)
-> BaggageBuilder a -> BaggageBuilder b -> BaggageBuilder c
liftA2 a -> b -> c
f (BaggageBuilder Either (DList BaggageError) a
mx) (BaggageBuilder Either (DList BaggageError) b
my) =
    Either (DList BaggageError) c -> BaggageBuilder c
forall a. Either (DList BaggageError) a -> BaggageBuilder a
BaggageBuilder (Either (DList BaggageError) c -> BaggageBuilder c)
-> Either (DList BaggageError) c -> BaggageBuilder c
forall a b. (a -> b) -> a -> b
$ case (Either (DList BaggageError) a
mx, Either (DList BaggageError) b
my) of
      (Left DList BaggageError
ex, Left DList BaggageError
ey) -> DList BaggageError -> Either (DList BaggageError) c
forall a b. a -> Either a b
Left (DList BaggageError -> Either (DList BaggageError) c)
-> DList BaggageError -> Either (DList BaggageError) c
forall a b. (a -> b) -> a -> b
$ DList BaggageError
ex DList BaggageError -> DList BaggageError -> DList BaggageError
forall a. Semigroup a => a -> a -> a
<> DList BaggageError
ey
      (Left DList BaggageError
ex, Right {}) -> DList BaggageError -> Either (DList BaggageError) c
forall a b. a -> Either a b
Left DList BaggageError
ex
      (Right {}, Left DList BaggageError
ey) -> DList BaggageError -> Either (DList BaggageError) c
forall a b. a -> Either a b
Left DList BaggageError
ey
      (Right a
x, Right b
y) -> c -> Either (DList BaggageError) c
forall a b. b -> Either a b
Right (c -> Either (DList BaggageError) c)
-> c -> Either (DList BaggageError) c
forall a b. (a -> b) -> a -> b
$ a -> b -> c
f a
x b
y

instance KV (BaggageBuilder Baggage) where
  type KVConstraints (BaggageBuilder Baggage) = IsTextKV
  .@ :: forall from to.
KVConstraints (BaggageBuilder Baggage) from to =>
Key to -> from -> BaggageBuilder Baggage
(.@) = Key to -> from -> BaggageBuilder Baggage
Key Text -> Text -> BaggageBuilder Baggage
go
    where
    go :: Key Text -> Text -> BaggageBuilder Baggage
    go :: Key Text -> Text -> BaggageBuilder Baggage
go (Key Text
keyText) Text
valText = do
      Text
baggageKey <- (Key Text -> Text)
-> BaggageBuilder (Key Text) -> BaggageBuilder Text
forall a b. (a -> b) -> BaggageBuilder a -> BaggageBuilder b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Key Text -> Text
forall a. Key a -> Text
unKey BaggageBuilder (Key Text)
parseKey
      Text
baggageVal <- BaggageBuilder Text
parseValue
      pure $ HashMap Text Text -> Baggage
Baggage (HashMap Text Text -> Baggage) -> HashMap Text Text -> Baggage
forall a b. (a -> b) -> a -> b
$ Text -> Text -> HashMap Text Text
forall k v. Hashable k => k -> v -> HashMap k v
HashMap.singleton Text
baggageKey Text
baggageVal
      where
      parseKey :: BaggageBuilder (Key Text)
      parseKey :: BaggageBuilder (Key Text)
parseKey =
        Either (DList BaggageError) (Key Text) -> BaggageBuilder (Key Text)
forall a. Either (DList BaggageError) a -> BaggageBuilder a
BaggageBuilder do
          if Text -> Bool
Text.null Text
keyText then do
            DList BaggageError -> Either (DList BaggageError) (Key Text)
forall a b. a -> Either a b
Left (DList BaggageError -> Either (DList BaggageError) (Key Text))
-> DList BaggageError -> Either (DList BaggageError) (Key Text)
forall a b. (a -> b) -> a -> b
$ BaggageError -> DList BaggageError
forall a. a -> DList a
DList.singleton (BaggageError -> DList BaggageError)
-> BaggageError -> DList BaggageError
forall a b. (a -> b) -> a -> b
$ BaggageKeyIsEmptyError -> BaggageError
BaggageKeyIsEmpty BaggageKeyIsEmptyError
              { $sel:rawValue:BaggageKeyIsEmptyError :: Text
rawValue = Text
valText
              }
          else if Bool -> Bool
not (Text -> Bool
Text.null Text
invalidChars) then do
            DList BaggageError -> Either (DList BaggageError) (Key Text)
forall a b. a -> Either a b
Left (DList BaggageError -> Either (DList BaggageError) (Key Text))
-> DList BaggageError -> Either (DList BaggageError) (Key Text)
forall a b. (a -> b) -> a -> b
$ BaggageError -> DList BaggageError
forall a. a -> DList a
DList.singleton (BaggageError -> DList BaggageError)
-> BaggageError -> DList BaggageError
forall a b. (a -> b) -> a -> b
$ BaggageKeyContainsInvalidCharsError -> BaggageError
BaggageKeyContainsInvalidChars BaggageKeyContainsInvalidCharsError
              { $sel:rawKey:BaggageKeyContainsInvalidCharsError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
              , $sel:rawValue:BaggageKeyContainsInvalidCharsError :: Text
rawValue = Text
valText
              , Text
invalidChars :: Text
$sel:invalidChars:BaggageKeyContainsInvalidCharsError :: Text
invalidChars
              }
          else do
            Key Text -> Either (DList BaggageError) (Key Text)
forall a b. b -> Either a b
Right (Key Text -> Either (DList BaggageError) (Key Text))
-> Key Text -> Either (DList BaggageError) (Key Text)
forall a b. (a -> b) -> a -> b
$ Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
        where
        invalidChars :: Text
invalidChars = (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isRFC7230TokenChar) Text
keyText

      parseValue :: BaggageBuilder Text
      parseValue :: BaggageBuilder Text
parseValue =
        Either (DList BaggageError) Text -> BaggageBuilder Text
forall a. Either (DList BaggageError) a -> BaggageBuilder a
BaggageBuilder do
          if Text -> Bool
Text.null Text
valText then do
            DList BaggageError -> Either (DList BaggageError) Text
forall a b. a -> Either a b
Left (DList BaggageError -> Either (DList BaggageError) Text)
-> DList BaggageError -> Either (DList BaggageError) Text
forall a b. (a -> b) -> a -> b
$ BaggageError -> DList BaggageError
forall a. a -> DList a
DList.singleton (BaggageError -> DList BaggageError)
-> BaggageError -> DList BaggageError
forall a b. (a -> b) -> a -> b
$ BaggageValueIsEmptyError -> BaggageError
BaggageValueIsEmpty BaggageValueIsEmptyError
              { $sel:rawKey:BaggageValueIsEmptyError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
              }
          else if Bool -> Bool
not (Text -> Bool
Text.null Text
invalidChars) then do
            DList BaggageError -> Either (DList BaggageError) Text
forall a b. a -> Either a b
Left (DList BaggageError -> Either (DList BaggageError) Text)
-> DList BaggageError -> Either (DList BaggageError) Text
forall a b. (a -> b) -> a -> b
$ BaggageError -> DList BaggageError
forall a. a -> DList a
DList.singleton (BaggageError -> DList BaggageError)
-> BaggageError -> DList BaggageError
forall a b. (a -> b) -> a -> b
$ BaggageValueContainsInvalidCharsError -> BaggageError
BaggageValueContainsInvalidChars BaggageValueContainsInvalidCharsError
              { $sel:rawKey:BaggageValueContainsInvalidCharsError :: Key Text
rawKey = Text -> Key Text
forall a. Text -> Key a
Key Text
keyText
              , $sel:rawValue:BaggageValueContainsInvalidCharsError :: Text
rawValue = Text
valText
              , Text
invalidChars :: Text
$sel:invalidChars:BaggageValueContainsInvalidCharsError :: Text
invalidChars
              }
          else do
            Text -> Either (DList BaggageError) Text
forall a. a -> Either (DList BaggageError) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
valText
        where
        invalidChars :: Text
invalidChars = (Char -> Bool) -> Text -> Text
Text.filter (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isRFC7230VCHARChar) Text
valText

buildBaggage
  :: forall m
   . (MonadThrow m)
  => BaggageBuilder Baggage
  -> m Baggage
buildBaggage :: forall (m :: * -> *).
MonadThrow m =>
BaggageBuilder Baggage -> m Baggage
buildBaggage BaggageBuilder Baggage
builder =
  case BaggageBuilder Baggage -> Either BaggageErrors Baggage
buildBaggagePure BaggageBuilder Baggage
builder of
    Left BaggageErrors
err -> BaggageErrors -> m Baggage
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Exception e) =>
e -> m a
throwM BaggageErrors
err
    Right Baggage
x -> Baggage -> m Baggage
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Baggage
x

buildBaggagePure :: BaggageBuilder Baggage -> Either BaggageErrors Baggage
buildBaggagePure :: BaggageBuilder Baggage -> Either BaggageErrors Baggage
buildBaggagePure = (DList BaggageError -> BaggageErrors)
-> Either (DList BaggageError) Baggage
-> Either BaggageErrors Baggage
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ([BaggageError] -> BaggageErrors
BaggageErrors ([BaggageError] -> BaggageErrors)
-> (DList BaggageError -> [BaggageError])
-> DList BaggageError
-> BaggageErrors
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DList BaggageError -> [BaggageError]
forall a. DList a -> [a]
DList.toList) (Either (DList BaggageError) Baggage
 -> Either BaggageErrors Baggage)
-> (BaggageBuilder Baggage -> Either (DList BaggageError) Baggage)
-> BaggageBuilder Baggage
-> Either BaggageErrors Baggage
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaggageBuilder Baggage -> Either (DList BaggageError) Baggage
forall a. BaggageBuilder a -> Either (DList BaggageError) a
unBaggageBuilder

contextBackendBaggage :: ContextBackend Baggage
contextBackendBaggage :: ContextBackend Baggage
contextBackendBaggage = IO (ContextBackend Baggage) -> ContextBackend Baggage
forall a. IO a -> a
unsafePerformIO (IO (ContextBackend Baggage) -> ContextBackend Baggage)
-> IO (ContextBackend Baggage) -> ContextBackend Baggage
forall a b. (a -> b) -> a -> b
$ IO (ContextBackend Baggage) -> IO (ContextBackend Baggage)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (ContextBackend Baggage)
forall (m :: * -> *) a.
(MonadIO m, Typeable a) =>
m (ContextBackend a)
unsafeNewContextBackend
{-# NOINLINE contextBackendBaggage #-}

contextKeyBaggage :: ContextKey Baggage
contextKeyBaggage :: ContextKey Baggage
contextKeyBaggage = ContextBackend Baggage -> ContextKey Baggage
forall a. ContextBackend a -> ContextKey a
contextBackendValueKey ContextBackend Baggage
contextBackendBaggage

isRFC7230TokenChar :: Char -> Bool
isRFC7230TokenChar :: Char -> Bool
isRFC7230TokenChar = \case
  Char
'!'  -> Bool
True
  Char
'#'  -> Bool
True
  Char
'$'  -> Bool
True
  Char
'%'  -> Bool
True
  Char
'&'  -> Bool
True
  Char
'\'' -> Bool
True
  Char
'*'  -> Bool
True
  Char
'+'  -> Bool
True
  Char
'-'  -> Bool
True
  Char
'.'  -> Bool
True
  Char
'^'  -> Bool
True
  Char
'_'  -> Bool
True
  Char
'`'  -> Bool
True
  Char
'|'  -> Bool
True
  Char
'~'  -> Bool
True
  Char
c    -> Char -> Bool
Char.isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
Char.isAlphaNum Char
c

isRFC7230VCHARChar :: Char -> Bool
isRFC7230VCHARChar :: Char -> Bool
isRFC7230VCHARChar Char
c = Char -> Bool
Char.isAscii Char
c Bool -> Bool -> Bool
&& Char -> Bool
Char.isPrint Char
c

_isRFC7230DelimiterChar :: Char -> Bool
_isRFC7230DelimiterChar :: Char -> Bool
_isRFC7230DelimiterChar = \case
  Char
'"'  -> Bool
True
  Char
'('  -> Bool
True
  Char
')'  -> Bool
True
  Char
','  -> Bool
True
  Char
'/'  -> Bool
True
  Char
':'  -> Bool
True
  Char
';'  -> Bool
True
  Char
'<'  -> Bool
True
  Char
'='  -> Bool
True
  Char
'>'  -> Bool
True
  Char
'?'  -> Bool
True
  Char
'@'  -> Bool
True
  Char
'['  -> Bool
True
  Char
'\\' -> Bool
True
  Char
']'  -> Bool
True
  Char
'{'  -> Bool
True
  Char
'}'  -> Bool
True
  Char
_    -> Bool
False

-- $disclaimer
--
-- In general, changes to this module will not be reflected in the library's
-- version updates. Direct use of this module should be done with utmost care,
-- otherwise invariants will easily be violated.