{-# LANGUAGE RankNTypes #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  OpenTelemetry.Trace.Propagator
-- Copyright   :  (c) Ian Duncan, 2021
-- License     :  BSD-3
-- Description :  Sending and receiving state between system boundaries
-- Maintainer  :  Ian Duncan
-- Stability   :  experimental
-- Portability :  non-portable (GHC extensions)
--
-- Cross-cutting concerns send their state to the next process using Propagators, which are defined as objects used to 
-- read and write context data to and from messages exchanged by the applications. 
-- Each concern creates a set of Propagators for every supported Propagator type.
--
-- Propagators leverage the Context to inject and extract data for each cross-cutting concern, such as traces and Baggage.
--
-- Propagation is usually implemented via a cooperation of library-specific request interceptors and Propagators, 
-- where the interceptors detect incoming and outgoing requests and use the Propagator's extract and inject operations 
-- respectively.
--
-- The Propagators API is expected to be leveraged by users writing instrumentation libraries. However,
-- users using the OpenTelemetry SDK may need to select appropriate propagators to work with existing 3rd party systems
-- such as AWS.
--
-----------------------------------------------------------------------------
module OpenTelemetry.Propagator where

import Control.Monad
import Control.Monad.IO.Class
import Data.Text

{- |
A carrier is the medium used by Propagators to read values from and write values to. 
Each specific Propagator type defines its expected carrier type, such as a string map or a byte array.
-}
data Propagator context inboundCarrier outboundCarrier = Propagator
  { Propagator context inboundCarrier outboundCarrier -> [Text]
propagatorNames :: [Text]
  , Propagator context inboundCarrier outboundCarrier
-> inboundCarrier -> context -> IO context
extractor :: inboundCarrier -> context -> IO context
  , Propagator context inboundCarrier outboundCarrier
-> context -> outboundCarrier -> IO outboundCarrier
injector :: context -> outboundCarrier -> IO outboundCarrier
  }

instance Semigroup (Propagator c i o) where
  (Propagator [Text]
lNames i -> c -> IO c
lExtract c -> o -> IO o
lInject) <> :: Propagator c i o -> Propagator c i o -> Propagator c i o
<> (Propagator [Text]
rNames i -> c -> IO c
rExtract c -> o -> IO o
rInject) = Propagator :: forall context inboundCarrier outboundCarrier.
[Text]
-> (inboundCarrier -> context -> IO context)
-> (context -> outboundCarrier -> IO outboundCarrier)
-> Propagator context inboundCarrier outboundCarrier
Propagator
    { propagatorNames :: [Text]
propagatorNames = [Text]
lNames [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text]
rNames
    , extractor :: i -> c -> IO c
extractor = \i
i -> i -> c -> IO c
lExtract i
i (c -> IO c) -> (c -> IO c) -> c -> IO c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> i -> c -> IO c
rExtract i
i
    , injector :: c -> o -> IO o
injector = \c
c -> c -> o -> IO o
lInject c
c (o -> IO o) -> (o -> IO o) -> o -> IO o
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> c -> o -> IO o
rInject c
c
    }

instance Monoid (Propagator c i o) where
  mempty :: Propagator c i o
mempty = [Text] -> (i -> c -> IO c) -> (c -> o -> IO o) -> Propagator c i o
forall context inboundCarrier outboundCarrier.
[Text]
-> (inboundCarrier -> context -> IO context)
-> (context -> outboundCarrier -> IO outboundCarrier)
-> Propagator context inboundCarrier outboundCarrier
Propagator [Text]
forall a. Monoid a => a
mempty (\i
_ c
c -> c -> IO c
forall (f :: * -> *) a. Applicative f => a -> f a
pure c
c) (\c
_ o
p -> o -> IO o
forall (f :: * -> *) a. Applicative f => a -> f a
pure o
p)

{- |
Extracts the value from an incoming request. For example, from the headers of an HTTP request.

If a value can not be parsed from the carrier, for a cross-cutting concern, the implementation MUST NOT throw an exception and MUST NOT store a new value in the Context, in order to preserve any previously existing valid value.
-}
extract :: (MonadIO m) 
  => Propagator context i o 
  -> i -- ^ The carrier that holds the propagation fields. For example, an incoming message or HTTP request.
  -> context 
  -> m context -- ^ a new Context derived from the Context passed as argument, containing the extracted value, which can be a SpanContext, Baggage or another cross-cutting concern context.
extract :: Propagator context i o -> i -> context -> m context
extract (Propagator [Text]
_ i -> context -> IO context
extractor context -> o -> IO o
_) i
i = IO context -> m context
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO context -> m context)
-> (context -> IO context) -> context -> m context
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> context -> IO context
extractor i
i

-- | Injects the value into a carrier. For example, into the headers of an HTTP request.
inject :: (MonadIO m) 
  => Propagator context i o 
  -> context 
  -> o -- ^ The carrier that holds the propagation fields. For example, an outgoing message or HTTP request. 
  -> m o
inject :: Propagator context i o -> context -> o -> m o
inject (Propagator [Text]
_ i -> context -> IO context
_ context -> o -> IO o
injector) context
c = IO o -> m o
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO o -> m o) -> (o -> IO o) -> o -> m o
forall b c a. (b -> c) -> (a -> b) -> a -> c
. context -> o -> IO o
injector context
c