shibuya-core-0.11.0.0: test/Shibuya/Telemetry/EffectSpec.hs
{-# LANGUAGE OverloadedStrings #-}
-- | Tests for the Tracing effect.
module Shibuya.Telemetry.EffectSpec (spec) where
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.Text (Text)
import Effectful (liftIO, runEff)
import OpenTelemetry.Trace.Core qualified as OTel
import OpenTelemetry.Trace.Id (Base (..), spanIdBaseEncodedText, traceIdBaseEncodedText)
import Shibuya.Telemetry.Effect
( addAttribute,
addEvent,
getTracer,
isTracingEnabled,
runTracingNoop,
setStatus,
withSpan,
withSpan',
)
import Shibuya.Telemetry.Propagation (injectTraceContext)
import Shibuya.Telemetry.Semantic (consumerSpanArgs, mkEvent)
import System.Mem.StableName (makeStableName)
import Test.Hspec
spec :: Spec
spec = describe "Shibuya.Telemetry.Effect" $ do
describe "runTracingNoop" $ do
it "executes actions and returns result" $ do
result <- runEff $ runTracingNoop $ do
pure (42 :: Int)
result `shouldBe` 42
it "executes nested withSpan without error" $ do
result <- runEff $ runTracingNoop $ do
withSpan "outer" consumerSpanArgs $ do
withSpan "inner" consumerSpanArgs $ do
pure ("success" :: String)
result `shouldBe` "success"
it "executes withSpan' and provides span handle" $ do
result <- runEff $ runTracingNoop $ do
withSpan' "test-span" consumerSpanArgs $ \traceSpan -> do
-- These should be no-ops but not error
addAttribute traceSpan "key" ("value" :: Text)
addEvent traceSpan (mkEvent "test.event" [])
setStatus traceSpan OTel.Ok
pure (123 :: Int)
result `shouldBe` 123
it "reports tracing as disabled" $ do
enabled <- runEff $ runTracingNoop $ isTracingEnabled
enabled `shouldBe` False
it "provides a tracer (noop)" $ do
result <- runEff $ runTracingNoop $ do
_tracer <- getTracer
pure ("got tracer" :: String)
result `shouldBe` "got tracer"
it "shares the compatibility provider across independent invocations" $ do
first <- runEff $ runTracingNoop getTracer
second <- runEff $ runTracingNoop getTracer
let firstProvider = OTel.getTracerTracerProvider first
secondProvider = OTel.getTracerTracerProvider second
firstProvider `seq` secondProvider `seq` pure ()
a <- makeStableName firstProvider
b <- makeStableName secondProvider
(a == b) `shouldBe` True
OTel.inSpan' second "direct noop tracer" OTel.defaultSpanArguments OTel.isRecording
`shouldReturn` False
it "provides an invalid non-recording sentinel that cannot be propagated" $ do
runEff $ runTracingNoop $ withSpan' "disabled" consumerSpanArgs $ \sp -> liftIO $ do
OTel.isRecording sp `shouldReturn` False
ctx <- OTel.getSpanContext sp
traceIdBaseEncodedText Base16 (OTel.traceId ctx) `shouldBe` "00000000000000000000000000000000"
spanIdBaseEncodedText Base16 (OTel.spanId ctx) `shouldBe` "0000000000000000"
injectTraceContext sp `shouldReturn` []
it "handles exceptions in actions correctly" $ do
ref <- newIORef (0 :: Int)
result <- runEff $ runTracingNoop $ do
withSpan "outer" consumerSpanArgs $ do
liftIO $ writeIORef ref 1
withSpan "inner" consumerSpanArgs $ do
liftIO $ writeIORef ref 2
pure ()
liftIO $ readIORef ref
result `shouldBe` 2
it "works with effectful actions" $ do
ref <- newIORef ([] :: [String])
let modifyIORef' r f = do
val <- readIORef r
writeIORef r (f val)
result <- runEff $ runTracingNoop $ do
withSpan "span1" consumerSpanArgs $ do
liftIO $ modifyIORef' ref ("span1" :)
withSpan "span2" consumerSpanArgs $ do
liftIO $ modifyIORef' ref ("span2" :)
liftIO $ readIORef ref
-- Order is reversed due to cons
result `shouldBe` ["span2", "span1"]
describe "Span operations (noop mode)" $ do
it "addAttribute is a no-op" $ do
result <- runEff $ runTracingNoop $ do
withSpan' "test" consumerSpanArgs $ \traceSpan -> do
addAttribute traceSpan "string" ("value" :: Text)
addAttribute traceSpan "int" (42 :: Int)
addAttribute traceSpan "bool" True
pure ("done" :: String)
result `shouldBe` ("done" :: String)
it "addEvent is a no-op" $ do
result <- runEff $ runTracingNoop $ do
withSpan' "test" consumerSpanArgs $ \traceSpan -> do
addEvent traceSpan (mkEvent "event1" [])
addEvent traceSpan (mkEvent "event2" [("key", OTel.toAttribute ("val" :: Text))])
pure ("done" :: String)
result `shouldBe` ("done" :: String)
it "setStatus is a no-op" $ do
result <- runEff $ runTracingNoop $ do
withSpan' "test" consumerSpanArgs $ \traceSpan -> do
setStatus traceSpan OTel.Ok
setStatus traceSpan (OTel.Error "test error")
setStatus traceSpan OTel.Unset
pure ("done" :: String)
result `shouldBe` ("done" :: String)