-- | Functions for dealing with 'Baggage'
--
-- We ported specs about 'Baggage' from the Java Propagator:
--
-- <https://github.com/open-telemetry/opentelemetry-java-contrib/blob/04a2a481934be614e73e41194107ffdd767bc507/aws-xray-propagator/src/test/java/io/opentelemetry/contrib/awsxray/propagator/AwsXrayPropagatorTest.java#L227-L238>
--
-- And using the obvious 'encodeBaggageHeader'/'decodeBaggageHeader' functions
-- fails them. So, we roll our own stuff here.
--
module OpenTelemetry.AWSXRay.Baggage
  ( decode
  , encode
  , module OpenTelemetry.Baggage
  ) where

import Prelude

import Control.Applicative (Alternative)
import Control.Arrow ((***))
import Control.Error.Util (hush)
import Control.Monad (guard)
import Data.ByteString (ByteString)
import qualified Data.HashMap.Strict as HashMap
import Data.Maybe (mapMaybe)
import Data.Text.Encoding (decodeUtf8', encodeUtf8)
import OpenTelemetry.Baggage (Baggage, Element, Token)
import OpenTelemetry.Baggage as Baggage

-- | Only returns 'Just' if the 'Baggage' is not empty
decode :: [(ByteString, ByteString)] -> Maybe Baggage
decode :: [(ByteString, ByteString)] -> Maybe Baggage
decode =
  forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
guarded (forall a. Eq a => a -> a -> Bool
/= Baggage
Baggage.empty)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Token Element -> Baggage
Baggage.fromHashMap
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (ByteString, ByteString) -> Maybe (Token, Element)
decodePart
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ((forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall {a}. IsString a => [a]
nonBaggageKeys) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
  where nonBaggageKeys :: [a]
nonBaggageKeys = [a
"Root", a
"Parent", a
"Sampled"]

decodePart :: (ByteString, ByteString) -> Maybe (Token, Element)
decodePart :: (ByteString, ByteString) -> Maybe (Token, Element)
decodePart (ByteString
bsToken, ByteString
bsElement) =
  (,)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> Maybe Token
Baggage.mkToken forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a b. Either a b -> Maybe b
hush (ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
bsToken))
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> Element
Baggage.element forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a b. Either a b -> Maybe b
hush (ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
bsElement))

encode :: Baggage -> [(ByteString, ByteString)]
encode :: Baggage -> [(ByteString, ByteString)]
encode = forall a b. (a -> b) -> [a] -> [b]
map (Token, Element) -> (ByteString, ByteString)
encodePart forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HashMap.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. Baggage -> HashMap Token Element
Baggage.values

encodePart :: (Token, Element) -> (ByteString, ByteString)
encodePart :: (Token, Element) -> (ByteString, ByteString)
encodePart = Token -> ByteString
Baggage.tokenValue forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Text -> ByteString
encodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Element -> Text
Baggage.value

guarded :: Alternative f => (a -> Bool) -> a -> f a
guarded :: forall (f :: * -> *) a. Alternative f => (a -> Bool) -> a -> f a
guarded a -> Bool
p a
x = a
x forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a -> Bool
p a
x)