hs-opentelemetry-api-0.1.0.0: test/Spec.hs

{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Exception
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Control.Monad.Reader
import qualified Data.Bifunctor
import Data.IORef
import Data.Maybe (isJust)
import qualified Data.Vector as V
import OpenTelemetry.Attributes (lookupAttribute)
-- Specs

import qualified OpenTelemetry.BaggageSpec as Baggage
import OpenTelemetry.Context
import OpenTelemetry.Trace.Core
import qualified OpenTelemetry.Trace.SamplerSpec as Sampler
import qualified OpenTelemetry.Trace.TraceFlagsSpec as TraceFlags
import OpenTelemetry.Util
import Test.Hspec
import qualified VectorBuilder.Vector as Builder


newtype TestException = TestException String
  deriving (Show)


instance Exception TestException


exceptionTest :: IO ()
exceptionTest = do
  tp <- getGlobalTracerProvider
  t <- OpenTelemetry.Trace.Core.getTracer tp "test" tracerOptions
  spanToCheck <- newIORef undefined
  handle (\(TestException _) -> pure ()) $ do
    inSpan' t "test" defaultSpanArguments $ \span -> do
      liftIO $ writeIORef spanToCheck span
      throw $ TestException "wow"
  spanState <- unsafeReadSpan =<< readIORef spanToCheck
  let ev = V.head $ appendOnlyBoundedCollectionValues $ spanEvents spanState
  eventName ev `shouldBe` "exception"
  eventAttributes ev `shouldSatisfy` \attrs ->
    isJust (lookupAttribute attrs "exception.type")
      && isJust (lookupAttribute attrs "exception.message")
      && isJust (lookupAttribute attrs "exception.stacktrace")


main :: IO ()
main = hspec $ do
  -- describe "inSpan" $ do
  --   it "records exceptions" $ do
  --     exceptionTest
  Baggage.spec
  Sampler.spec
  TraceFlags.spec