{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Instana.SDK.Internal.W3CTraceContextTest (allTests) where


import           Data.Text                            (Text)
import qualified Data.Text                            as T
import           Test.HUnit

import qualified Instana.SDK.Internal.Id              as Id
import           Instana.SDK.Internal.W3CTraceContext (Flags (..),
                                                       InstanaKeyValuePair (..),
                                                       TraceParent (..),
                                                       TraceState (..),
                                                       W3CTraceContext (..))
import qualified Instana.SDK.Internal.W3CTraceContext as W3CTraceContext


allTests :: Test
allTests =
  TestList
    [ TestLabel
        "shouldDecodeEmptyTraceParentHeaderToNothing"
        shouldDecodeEmptyTraceParentHeaderToNothing
    , TestLabel
        "shouldDecodeWhitespaceTraceParentHeaderToNothing"
        shouldDecodeWhitespaceTraceParentHeaderToNothing
    , TestLabel
        "shouldDecodeMalformedTraceParentHeaderToNothing"
        shouldDecodeMalformedTraceParentHeaderToNothing
    , TestLabel
        "shouldDecodeWrongComponentLengthToNothing"
        shouldDecodeWrongComponentLengthToNothing
    , TestLabel
        "shouldDecodeInvalidVersionContentToNothing"
        shouldDecodeInvalidVersionContentToNothing
    , TestLabel
        "shouldDecodeInvalidVersionContentToNothing2"
        shouldDecodeInvalidVersionContentToNothing2
    , TestLabel
        "shouldDecodeInvalidTraceIdContentToNothing"
        shouldDecodeInvalidTraceIdContentToNothing
    , TestLabel
        "shouldDecodeInvalidTraceIdContentToNothing2"
        shouldDecodeInvalidTraceIdContentToNothing2
    , TestLabel
        "shouldDecodeInvalidParentIdContentToNothing"
        shouldDecodeInvalidParentIdContentToNothing
    , TestLabel
        "shouldDecodeInvalidParentIdContentToNothing2"
        shouldDecodeInvalidParentIdContentToNothing2
    , TestLabel
        "shouldDecodeInvalidFlagsContentToNothing"
        shouldDecodeInvalidFlagsContentToNothing
    , TestLabel
        "shouldDecodeValidTraceParent"
        shouldDecodeValidTraceParent
    , TestLabel
        "shouldDecodeUnsampledTraceParent"
        shouldDecodeUnsampledTraceParent
    , TestLabel
        "shouldDecodeKnownPartsFromHigherVersionTraceParent"
        shouldDecodeKnownPartsFromHigherVersionTraceParent
    , TestLabel
        "shouldDecodeAbsentTraceState"
        shouldDecodeAbsentTraceState
    , TestLabel
        "shouldDecodeEmptyTraceState"
        shouldDecodeEmptyTraceState
    , TestLabel
        "shouldDecodeWhitespaceTraceState"
        shouldDecodeWhitespaceTraceState
    , TestLabel
        "shouldDecodeTraceStateWithoutInstanaKeyValuePair"
        shouldDecodeTraceStateWithoutInstanaKeyValuePair
    , TestLabel
        "shouldDecodeTraceStateWithInstanaKeyValuePairAtBeginning"
        shouldDecodeTraceStateWithInstanaKeyValuePairAtBeginning
    , TestLabel
        "shouldDecodeTraceStateWithInstanaKeyValuePairInTheMiddle"
        shouldDecodeTraceStateWithInstanaKeyValuePairInTheMiddle
    , TestLabel
        "shouldDecodeTraceStateWithInstanaKeyValuePairAtTheEnd"
        shouldDecodeTraceStateWithInstanaKeyValuePairAtTheEnd
    , TestLabel
        "shouldDecodeTraceStateWithWhitespace"
        shouldDecodeTraceStateWithWhitespace
    , TestLabel
        "shouldDiscardExcessTraceStateListMembersWithoutInstanaKeyValuePair"
        shouldDiscardExcessTraceStateListMembersWithoutInstanaKeyValuePair
    , TestLabel
        "shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePair"
        shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePair
    , TestLabel
        "shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt32"
        shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt32
    , TestLabel
        "shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt33"
        shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt33
    , TestLabel
        "shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt66"
        shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt66
    , TestLabel
        "shouldDiscardMalformedInstanaKeyValuePair"
        shouldDiscardMalformedInstanaKeyValuePair
    , TestLabel
        "shouldInherit"
        shouldInherit
    , TestLabel
        "shouldInheritForSuppressed"
        shouldInheritForSuppressed
    , TestLabel
        "shouldCreateExitSpanContextFromIds"
        shouldCreateExitSpanContextFromIds
    , TestLabel
        "shouldCreateExitForSuppressed"
        shouldCreateExitForSuppressed
    , TestLabel
        "shouldEncodeToHeaders"
        shouldEncodeToHeaders
    , TestLabel
        "shouldPadShortIds"
        shouldPadShortIds
    , TestLabel
        "shouldLimitLongIds"
        shouldLimitLongIds
    , TestLabel
        "shouldDecodeInheritAndEncode"
        shouldDecodeInheritAndEncode
    ]


shouldDecodeEmptyTraceParentHeaderToNothing :: Test
shouldDecodeEmptyTraceParentHeaderToNothing = testInvalidTraceParent ""


shouldDecodeWhitespaceTraceParentHeaderToNothing :: Test
shouldDecodeWhitespaceTraceParentHeaderToNothing =
  testInvalidTraceParent "  \t \r\n "


shouldDecodeMalformedTraceParentHeaderToNothing :: Test
shouldDecodeMalformedTraceParentHeaderToNothing = testInvalidTraceParent "foo"


shouldDecodeWrongComponentLengthToNothing :: Test
shouldDecodeWrongComponentLengthToNothing =
  testInvalidTraceParent "beep-bop-beep-bop"


shouldDecodeInvalidVersionContentToNothing :: Test
shouldDecodeInvalidVersionContentToNothing =
  testInvalidTraceParent
    "xx-1234567890abcdeffedcba0987654321-24680bdf13579abc-01"


shouldDecodeInvalidVersionContentToNothing2 :: Test
shouldDecodeInvalidVersionContentToNothing2 =
  testInvalidTraceParent
    "ff-1234567890abcdeffedcba0987654321-24680bdf13579abc-01"


shouldDecodeInvalidTraceIdContentToNothing :: Test
shouldDecodeInvalidTraceIdContentToNothing =
  testInvalidTraceParent
    "00-ABCD567890abcdeffedcba0987654321-24680bdf13579abc-01"


shouldDecodeInvalidTraceIdContentToNothing2 :: Test
shouldDecodeInvalidTraceIdContentToNothing2 =
  testInvalidTraceParent
    "00-00000000000000000000000000000000-24680bdf13579abc-01"


shouldDecodeInvalidParentIdContentToNothing :: Test
shouldDecodeInvalidParentIdContentToNothing =
  testInvalidTraceParent
    "00-1234567890abcdeffedcba0987654321-hijklmnopq579abc-01"


shouldDecodeInvalidParentIdContentToNothing2 :: Test
shouldDecodeInvalidParentIdContentToNothing2 =
  testInvalidTraceParent
    "00-1234567890abcdeffedcba0987654321-0000000000000000-01"


shouldDecodeInvalidFlagsContentToNothing :: Test
shouldDecodeInvalidFlagsContentToNothing =
  testInvalidTraceParent
    "00-1234567890abcdeffedcba0987654321-24680bdf13579abc-XX"


shouldDecodeValidTraceParent :: Test
shouldDecodeValidTraceParent =
  let
    actual =
      W3CTraceContext.decode
        "00-1234567890abcdeffedcba0987654321-24680bdf13579abc-01"
        Nothing
    expected =
      sampledWithoutTraceState
        "1234567890abcdeffedcba0987654321"
        "24680bdf13579abc"
  in
  TestCase $ do
    assertEqual "W3C Trace Context" expected actual


shouldDecodeUnsampledTraceParent :: Test
shouldDecodeUnsampledTraceParent =
  let
    actual =
      W3CTraceContext.decode
        "00-1234567890abcdeffedcba0987654321-24680bdf13579abc-00"
        Nothing
    expected =
      unsampledWithoutTraceState
        "1234567890abcdeffedcba0987654321"
        "24680bdf13579abc"
  in
  TestCase $ do
    assertEqual "W3C Trace Context" expected actual


shouldDecodeKnownPartsFromHigherVersionTraceParent :: Test
shouldDecodeKnownPartsFromHigherVersionTraceParent =
  let
    actual =
      W3CTraceContext.decode
        "01-1234567890abcdeffedcba0987654321-24680bdf13579abc-01-beep-boop"
        Nothing
    expected =
      sampledWithoutTraceState
        "1234567890abcdeffedcba0987654321"
        "24680bdf13579abc"
  in
  TestCase $ do
    assertEqual "W3C Trace Context" expected actual


testInvalidTraceParent :: String -> Test
testInvalidTraceParent tpContext =
  let
    w3cTraceContext = W3CTraceContext.decode tpContext Nothing
  in
  TestCase $ do
    assertEqual "W3C Trace Context"
      Nothing
      w3cTraceContext


shouldDecodeAbsentTraceState :: Test
shouldDecodeAbsentTraceState =
  let
    actual = parseAndExtractTraceState Nothing
    expected = traceState $
      withTraceState defaultTraceParent Nothing Nothing Nothing
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDecodeEmptyTraceState :: Test
shouldDecodeEmptyTraceState =
  let
    actual = parseAndExtractTraceState (Just "")
    expected = traceState $
      withTraceState defaultTraceParent Nothing Nothing Nothing
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDecodeWhitespaceTraceState :: Test
shouldDecodeWhitespaceTraceState =
  let
    actual = parseAndExtractTraceState (Just "  \t  \r\n  ")
    expected = traceState $
      withTraceState defaultTraceParent Nothing Nothing Nothing
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDecodeTraceStateWithoutInstanaKeyValuePair :: Test
shouldDecodeTraceStateWithoutInstanaKeyValuePair =
  let
    actual =
      parseAndExtractTraceState $ Just
        "congo=ucfJifl5GOE,rojo=00f067aa0ba902b7"
    expected = traceState $ withTraceState
      defaultTraceParent
      (Just $ T.pack "congo=ucfJifl5GOE,rojo=00f067aa0ba902b7")
      Nothing
      Nothing
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDecodeTraceStateWithInstanaKeyValuePairAtBeginning :: Test
shouldDecodeTraceStateWithInstanaKeyValuePairAtBeginning =
  let
    actual =
      parseAndExtractTraceState $ Just
        "in=fa2375d711a4ca0f;02468acefdb97531,congo=ucfJifl5GOE,rojo=00f067aa0ba902b7"
    expected =
      traceState $
        withTraceState
          defaultTraceParent
          Nothing
          (Just $ InstanaKeyValuePair
             { instanaTraceId = "fa2375d711a4ca0f"
             , instanaParentId = "02468acefdb97531"
             }
          )
          (Just $ T.pack "congo=ucfJifl5GOE,rojo=00f067aa0ba902b7")
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDecodeTraceStateWithInstanaKeyValuePairInTheMiddle :: Test
shouldDecodeTraceStateWithInstanaKeyValuePairInTheMiddle =
  let
    actual =
      parseAndExtractTraceState $ Just
        "congo=ucfJifl5GOE,in=fa2375d711a4ca0f;02468acefdb97531,rojo=00f067aa0ba902b7"
    expected =
      traceState $
        withTraceState
          defaultTraceParent
          (Just $ T.pack "congo=ucfJifl5GOE")
          (Just $ InstanaKeyValuePair
             { instanaTraceId = "fa2375d711a4ca0f"
             , instanaParentId = "02468acefdb97531"
             }
          )
          (Just $ T.pack "rojo=00f067aa0ba902b7")
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDecodeTraceStateWithInstanaKeyValuePairAtTheEnd :: Test
shouldDecodeTraceStateWithInstanaKeyValuePairAtTheEnd =
  let
    actual =
      parseAndExtractTraceState $ Just
        "congo=ucfJifl5GOE,rojo=00f067aa0ba902b7,in=fa2375d711a4ca0f;02468acefdb97531"
    expected =
      traceState $
        withTraceState
          defaultTraceParent
          (Just $ T.pack "congo=ucfJifl5GOE,rojo=00f067aa0ba902b7")
          (Just $ InstanaKeyValuePair
             { instanaTraceId = "fa2375d711a4ca0f"
             , instanaParentId = "02468acefdb97531"
             }
          )
          Nothing
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDecodeTraceStateWithWhitespace :: Test
shouldDecodeTraceStateWithWhitespace =
  let
    actual =
      parseAndExtractTraceState $ Just
        "  congo = ucfJifl5GOE ,  in   =   fa2375d711a4ca0f  ; 02468acefdb97531   ,  rojo  =  00f067aa0ba902b7  "
    expected =
      traceState $
        withTraceState
          defaultTraceParent
          (Just $ T.pack "congo = ucfJifl5GOE")
          (Just $ InstanaKeyValuePair
             { instanaTraceId = "fa2375d711a4ca0f"
             , instanaParentId = "02468acefdb97531"
             }
          )
          (Just $ T.pack "rojo  =  00f067aa0ba902b7")
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDiscardExcessTraceStateListMembersWithoutInstanaKeyValuePair :: Test
shouldDiscardExcessTraceStateListMembersWithoutInstanaKeyValuePair =
  let
    actual =
      parseAndExtractTraceState $ Just $ T.unpack $ longTraceStateList 1 34
    expected = traceState $
      withTraceState
        defaultTraceParent
        ( Just $ longTraceStateList 1 32 )
        Nothing
        Nothing
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePair :: Test
shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePair =
  let
    actual =
      parseAndExtractTraceState $ Just $
        (T.unpack $ longTraceStateList 1 10) ++
        ",in=fa2375d711a4ca0f;02468acefdb97531," ++
        (T.unpack $ longTraceStateList 12 34)
    expected = traceState $
      withTraceState
        defaultTraceParent
        ( Just $ longTraceStateList 1 10 )
        ( Just $ InstanaKeyValuePair
             { instanaTraceId = "fa2375d711a4ca0f"
             , instanaParentId = "02468acefdb97531"
             }
        )
        ( Just $ longTraceStateList 12 32 )
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt32 :: Test
shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt32 =
  let
    actual =
      parseAndExtractTraceState $ Just $
        (T.unpack $ longTraceStateList 1 31) ++
        ",in=fa2375d711a4ca0f;02468acefdb97531," ++
        (T.unpack $ longTraceStateList 33 34)
    expected = traceState $
      withTraceState
        defaultTraceParent
        ( Just $ longTraceStateList 1 31 )
        ( Just $ InstanaKeyValuePair
             { instanaTraceId = "fa2375d711a4ca0f"
             , instanaParentId = "02468acefdb97531"
             }
        )
        Nothing
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt33 :: Test
shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt33 =
  let
    actual =
      parseAndExtractTraceState $ Just $
        (T.unpack $ longTraceStateList 1 32) ++
        ",in=fa2375d711a4ca0f;02468acefdb97531," ++
        (T.unpack $ longTraceStateList 34 35)
    expected = traceState $
      withTraceState
        defaultTraceParent
        ( Just $ longTraceStateList 1 31 )
        ( Just $ InstanaKeyValuePair
             { instanaTraceId = "fa2375d711a4ca0f"
             , instanaParentId = "02468acefdb97531"
             }
        )
        Nothing
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt66 :: Test
shouldDiscardExcessTraceStateListMembersWithInstanaKeyValuePairAt66 =
  let
    actual =
      parseAndExtractTraceState $ Just $
        (T.unpack $ longTraceStateList 1 65) ++
        ",in=fa2375d711a4ca0f;02468acefdb97531," ++
        (T.unpack $ longTraceStateList 67 99)
    expected = traceState $
      withTraceState
        defaultTraceParent
        ( Just $ longTraceStateList 1 31 )
        ( Just $ InstanaKeyValuePair
             { instanaTraceId = "fa2375d711a4ca0f"
             , instanaParentId = "02468acefdb97531"
             }
        )
        Nothing
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


longTraceStateList :: Int -> Int -> Text
longTraceStateList from to =
  T.intercalate
    ","
    [ T.pack $
        "member" ++ show i ++ "=" ++ show i | i <- [from..to] ]


shouldDiscardMalformedInstanaKeyValuePair :: Test
shouldDiscardMalformedInstanaKeyValuePair =
  let
    actual =
      parseAndExtractTraceState $ Just
        "congo=ucfJifl5GOE,in=malformed,rojo=00f067aa0ba902b7"
    expected =
      traceState $
        withTraceState
          defaultTraceParent
          (Just $ T.pack "congo=ucfJifl5GOE")
          Nothing
          (Just $ T.pack "rojo=00f067aa0ba902b7")
  in
  TestCase $ do
    assertEqual "Trace State" expected actual


shouldInherit :: Test
shouldInherit =
  let
    initialW3cCtx =
      withTraceState
        defaultTraceParent
        (Just $ T.pack "congo=ucfJifl5GOE")
        (Just $ InstanaKeyValuePair
           { instanaTraceId = "fa2375d711a4ca0f"
           , instanaParentId = "02468acefdb97531"
           }
        )
        (Just $ T.pack "rojo=00f067aa0ba902b7")

    actual =
      W3CTraceContext.inheritFrom
        initialW3cCtx
        "5a6b7c8d9ef13402"
        "234123567890abcd"

    expected =
      W3CTraceContext
        { traceParent = TraceParent
          { version  = 0
          , traceId  = "1234567890abcdeffedcba0987654321"
          , parentId = "234123567890abcd"
          , flags    = Flags
            { sampled = True
            }
          }
        , traceState = TraceState
         { traceStateHead = Nothing
          , instanaKeyValuePair = Just InstanaKeyValuePair
            { instanaTraceId = "5a6b7c8d9ef13402"
            , instanaParentId = "234123567890abcd"
            }
          , traceStateTail = Just "congo=ucfJifl5GOE,rojo=00f067aa0ba902b7"
          }
        }
  in
  TestCase $ do
    assertEqual "W3C Trace Context" expected actual


shouldInheritForSuppressed :: Test
shouldInheritForSuppressed =
  let
    initialW3cCtx =
      withTraceState
        defaultTraceParent
        (Just $ T.pack "congo=ucfJifl5GOE")
        (Just $ InstanaKeyValuePair
           { instanaTraceId = "fa2375d711a4ca0f"
           , instanaParentId = "02468acefdb97531"
           }
        )
        (Just $ T.pack "rojo=00f067aa0ba902b7")

    actual =
      W3CTraceContext.inheritFromForSuppressed
        initialW3cCtx
        "234123567890abcd"

    expected =
      W3CTraceContext
        { traceParent = TraceParent
          { version  = 0
          , traceId  = "1234567890abcdeffedcba0987654321"
          , parentId = "234123567890abcd"
          , flags    = Flags
            { sampled = False
            }
          }
        , traceState = TraceState
          { traceStateHead = Just "congo=ucfJifl5GOE"
          , instanaKeyValuePair = Nothing
          , traceStateTail = Just "rojo=00f067aa0ba902b7"
          }
        }
  in
  TestCase $ do
    assertEqual "W3C Trace Context" expected actual


shouldCreateExitSpanContextFromIds :: Test
shouldCreateExitSpanContextFromIds =
  let
    actual =
      W3CTraceContext.exitSpanContextFromIds
        "274193a6f8c03721"
        "345fcb9140c8a6b9"

    expected =
      W3CTraceContext
        { traceParent = TraceParent
          { version  = 0
          , traceId  = "274193a6f8c03721"
          , parentId = "345fcb9140c8a6b9"
          , flags    = Flags
            { sampled = True
            }
          }
        , traceState = TraceState
          { traceStateHead = Nothing
          , instanaKeyValuePair = Just InstanaKeyValuePair
            { instanaTraceId  = "274193a6f8c03721"
            , instanaParentId = "345fcb9140c8a6b9"
            }
          , traceStateTail = Nothing
          }
        }
  in
  TestCase $ do
    assertEqual "W3C Trace Context" expected actual


shouldCreateExitForSuppressed :: Test
shouldCreateExitForSuppressed =
  let
    actual =
      W3CTraceContext.createExitContextForSuppressed
        "274193a6f8c03721"
        "345fcb9140c8a6b9"

    expected =
      W3CTraceContext
        { traceParent = TraceParent
          { version  = 0
          , traceId  = "274193a6f8c03721"
          , parentId = "345fcb9140c8a6b9"
          , flags    = Flags
            { sampled = False
            }
          }
        , traceState = TraceState
          { traceStateHead = Nothing
          , instanaKeyValuePair = Nothing
          , traceStateTail = Nothing
          }
        }
  in
  TestCase $ do
    assertEqual "W3C Trace Context" expected actual


shouldEncodeToHeaders :: Test
shouldEncodeToHeaders =
  let
    actual =
      W3CTraceContext.toHeaders $
        withTraceState
          defaultTraceParent
          (Just $ T.pack "congo=ucfJifl5GOE")
          (Just $ InstanaKeyValuePair
             { instanaTraceId = "fa2375d711a4ca0f"
             , instanaParentId = "02468acefdb97531"
             }
          )
          (Just $ T.pack "rojo=00f067aa0ba902b7")

    expected =
      [ ( "traceparent"
        , "00-1234567890abcdeffedcba0987654321-24680bdf13579abc-01"
        )
      , ( "tracestate"
        , "in=fa2375d711a4ca0f;02468acefdb97531,congo=ucfJifl5GOE,rojo=00f067aa0ba902b7"
        )
      ]
  in
  TestCase $ do
    assertEqual "W3C Trace Context Headers" expected actual


shouldPadShortIds :: Test
shouldPadShortIds =
  let
    Just w3cCtx =
      (sampledWithoutTraceState
        "1234"
        "5678")
    actual =
      W3CTraceContext.toHeaders $
        withTraceState
          (traceParent w3cCtx)
          (Just $ T.pack "congo=ucfJifl5GOE")
          (Just $ InstanaKeyValuePair
             { instanaTraceId = "9abc"
             , instanaParentId = "defg"
             }
          )
          (Just $ T.pack "rojo=00f067aa0ba902b7")

    expected =
      [ ( "traceparent"
        , "00-00000000000000000000000000001234-0000000000005678-01"
        )
      , ( "tracestate"
        , "in=0000000000009abc;000000000000defg,congo=ucfJifl5GOE,rojo=00f067aa0ba902b7"
        )
      ]
  in
  TestCase $ do
    assertEqual "W3C Trace Context Headers" expected actual


shouldLimitLongIds :: Test
shouldLimitLongIds =
  let
    Just w3cCtx =
      (sampledWithoutTraceState
        "fedcba9876543210abcdef0123456789fffff"
        "112233445566778899")
    actual =
      W3CTraceContext.toHeaders w3cCtx

    expected =
      [ ( "traceparent"
        , "00-a9876543210abcdef0123456789fffff-2233445566778899-01"
        )
      ]
  in
  TestCase $ do
    assertEqual "W3C Trace Context Headers" expected actual


shouldDecodeInheritAndEncode :: Test
shouldDecodeInheritAndEncode =
  let
    Just decoded =
      W3CTraceContext.decode
        "00-1234567890abcdeffedcba0987654321-24680bdf13579abc-01"
        (Just "congo=ucfJifl5GOE,in=fa2375d711a4ca0f;02468acefdb97531,rojo=00f067aa0ba902b7")

    childCtx =
      W3CTraceContext.inheritFrom
        decoded
        "5a6b7c8d9ef13402"
        "234123567890abcd"

    actual =
      W3CTraceContext.toHeaders childCtx

    expected =
      [ ( "traceparent"
        , "00-1234567890abcdeffedcba0987654321-234123567890abcd-01"
        )
      , ( "tracestate"
        , "in=5a6b7c8d9ef13402;234123567890abcd,congo=ucfJifl5GOE,rojo=00f067aa0ba902b7"
        )
      ]
  in
  TestCase $ do
    assertEqual "W3C Trace Context Headers" expected actual


sampledWithoutTraceState :: String -> String -> Maybe W3CTraceContext
sampledWithoutTraceState tId pId =
  Just $
    W3CTraceContext
      { traceParent = TraceParent
        { version  = 0
        , traceId  = Id.fromString tId
        , parentId = Id.fromString pId
        , flags    = Flags
          { sampled = True
          }
        }
      , traceState = TraceState
        { traceStateHead = Nothing
        , instanaKeyValuePair = Nothing
        , traceStateTail = Nothing
        }
      }


unsampledWithoutTraceState :: String -> String -> Maybe W3CTraceContext
unsampledWithoutTraceState tId pId =
  unsampled $ sampledWithoutTraceState tId pId


unsampled :: Maybe W3CTraceContext -> Maybe W3CTraceContext
unsampled mW3cCtx =
  let
    Just w3cCtx = mW3cCtx
    tp = traceParent w3cCtx
    fl = flags tp
    unsampledTp = tp { flags = fl { sampled = False } }
  in
  Just $ w3cCtx { traceParent = unsampledTp }


parseAndExtractTraceState :: Maybe String -> TraceState
parseAndExtractTraceState traceStateHeader =
  let
    Just w3cCtx =
        W3CTraceContext.decode
          "00-1234567890abcdeffedcba0987654321-24680bdf13579abc-01"
          traceStateHeader
  in
  traceState $ w3cCtx


withTraceState ::
  TraceParent
  -> Maybe Text
  -> Maybe InstanaKeyValuePair
  -> Maybe Text
  -> W3CTraceContext
withTraceState tp tsHead inKvPair tsTail =
  W3CTraceContext
    { traceParent = tp
    , traceState = TraceState
      { traceStateHead = tsHead
      , instanaKeyValuePair = inKvPair
      , traceStateTail = tsTail
      }
    }


defaultTraceParent :: TraceParent
defaultTraceParent =
  TraceParent
    { version  = 0
    , traceId  = "1234567890abcdeffedcba0987654321"
    , parentId = "24680bdf13579abc"
    , flags    = Flags
      { sampled = True
      }
    }