{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module OpenTelemetry.Propagator.W3CBaggage where

import Data.ByteString
import Network.HTTP.Types
import qualified OpenTelemetry.Baggage as Baggage
import OpenTelemetry.Context (Context, insertBaggage, lookupBaggage)
import OpenTelemetry.Propagator

decodeBaggage :: ByteString -> Maybe Baggage.Baggage
decodeBaggage :: ByteString -> Maybe Baggage
decodeBaggage ByteString
bs = case ByteString -> Either String Baggage
Baggage.decodeBaggageHeader ByteString
bs of
  Left String
_ -> Maybe Baggage
forall a. Maybe a
Nothing
  Right Baggage
b -> Baggage -> Maybe Baggage
forall a. a -> Maybe a
Just Baggage
b

encodeBaggage :: Baggage.Baggage -> ByteString
encodeBaggage :: Baggage -> ByteString
encodeBaggage = Baggage -> ByteString
Baggage.encodeBaggageHeader

w3cBaggagePropagator :: Propagator Context RequestHeaders ResponseHeaders
w3cBaggagePropagator :: Propagator Context RequestHeaders RequestHeaders
w3cBaggagePropagator = Propagator :: forall context inboundCarrier outboundCarrier.
[Text]
-> (inboundCarrier -> context -> IO context)
-> (context -> outboundCarrier -> IO outboundCarrier)
-> Propagator context inboundCarrier outboundCarrier
Propagator{[Text]
RequestHeaders -> Context -> IO Context
Context -> RequestHeaders -> IO RequestHeaders
forall a (f :: * -> *).
(Eq a, IsString a, Applicative f) =>
[(a, ByteString)] -> Context -> f Context
forall (f :: * -> *) a.
(Applicative f, IsString a) =>
Context -> [(a, ByteString)] -> f [(a, ByteString)]
propagatorNames :: [Text]
extractor :: RequestHeaders -> Context -> IO Context
injector :: Context -> RequestHeaders -> IO RequestHeaders
injector :: forall (f :: * -> *) a.
(Applicative f, IsString a) =>
Context -> [(a, ByteString)] -> f [(a, ByteString)]
extractor :: forall a (f :: * -> *).
(Eq a, IsString a, Applicative f) =>
[(a, ByteString)] -> Context -> f Context
propagatorNames :: [Text]
..}
  where
    propagatorNames :: [Text]
propagatorNames = [ Text
"baggage" ]

    extractor :: [(a, ByteString)] -> Context -> f Context
extractor [(a, ByteString)]
hs Context
c = case a -> [(a, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup a
"baggage" [(a, ByteString)]
hs of
      Maybe ByteString
Nothing -> Context -> f Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context
c
      Just ByteString
baggageHeader -> case ByteString -> Maybe Baggage
decodeBaggage ByteString
baggageHeader of
        Maybe Baggage
Nothing -> Context -> f Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure Context
c
        Just Baggage
baggage -> Context -> f Context
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Context -> f Context) -> Context -> f Context
forall a b. (a -> b) -> a -> b
$! Baggage -> Context -> Context
insertBaggage Baggage
baggage Context
c

    injector :: Context -> [(a, ByteString)] -> f [(a, ByteString)]
injector Context
c [(a, ByteString)]
hs = do
      case Context -> Maybe Baggage
lookupBaggage Context
c of
        Maybe Baggage
Nothing -> [(a, ByteString)] -> f [(a, ByteString)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [(a, ByteString)]
hs
        Just Baggage
baggage -> [(a, ByteString)] -> f [(a, ByteString)]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(a, ByteString)] -> f [(a, ByteString)])
-> [(a, ByteString)] -> f [(a, ByteString)]
forall a b. (a -> b) -> a -> b
$! ((a
"baggage", Baggage -> ByteString
encodeBaggage Baggage
baggage) (a, ByteString) -> [(a, ByteString)] -> [(a, ByteString)]
forall a. a -> [a] -> [a]
: [(a, ByteString)]
hs)