LoggingSpec.hs

{-# OPTIONS_GHC -Wno-name-shadowing #-}
{-# OPTIONS_GHC -Wno-type-defaults #-}

module Effectful.OpenTelemetry.LoggingSpec (spec) where

import Arbitrary (Marker (..))
import Data.Aeson.Types (Value (..))
import Data.Functor ((<&>))
import Data.Maybe (isJust)
import Effectful
import Effectful.Concurrent (runConcurrent)
import Effectful.Concurrent.Async (replicateConcurrently_)
import Effectful.HUnit (HUnit)
import Effectful.Hspec
import Effectful.OpenTelemetry.Logging
import Effectful.OpenTelemetry.Logging.Severity qualified as Severity
import Effectful.OpenTelemetry.Timestamp (Timestamp (..))
import Effectful.OpenTelemetry.Tracing
import Effectful.OpenTelemetry.Tracing.Span.Context qualified as Span.Context
import Effectful.OpenTelemetry.Tracing.Span.Kind qualified as Span.Kind
import Util
import Prelude hiding (log)

info :: (Logging :> es) => Value -> Eff es ()
info v = log Severity.Info v mempty Nothing

spec :: (IOE :> es, HUnit :> es, Hspec :> es) => Eff es ()
spec = runConcurrent . parallel $ do
    prop "emits a single log record" \severity body attributes name -> do
        record <-
            only . snd =<< (runNoTracing . runInMemoryLogging) do
                log severity body attributes (getMarker <$> name)
        record.severity `shouldBe` severity
        record.body `shouldBe` body
        record.attributes `shouldBe` attributes
        record.eventName `shouldBe` (getMarker <$> name)
        record.timestamp.nanos `shouldSatisfy` (> 0)

    prop "emits multiple log records in order" \body1 body2 body3 -> do
        (_, records) <- runNoTracing . runInMemoryLogging $ do
            log Severity.Info body1 mempty Nothing
            log Severity.Debug body2 mempty Nothing
            log Severity.Error body3 mempty Nothing
        (records <&> (.body)) `shouldBe` [body1, body2, body3]

    it "has no span context outside of a span" do
        record <- only . snd =<< (runNoTracing . runInMemoryLogging) do info $ String "test"
        record.context `shouldBe` Nothing

    it "correlates with innermost span" do
        ((_, records), spans) <- runInMemoryTracing . runInMemoryLogging $ do
            inSpan "outer" Span.Kind.Internal mempty
                . inSpan "inner" Span.Kind.Internal mempty
                . info
                $ String "test"
        record <- only records
        case filter (("inner" ==) . (.name)) spans of
            [inner] -> (record.context <&> (.spanId)) `shouldBe` Just inner.context.spanId
            _ -> expectationFailure "expected exactly one inner span"

    it "different logs correlate with their enclosing spans" do
        ((_, records), spans) <- runInMemoryTracing . runInMemoryLogging $ do
            inSpan "span-a" Span.Kind.Internal mempty . info $ String "test1"
            inSpan "span-b" Span.Kind.Internal mempty . info $ String "test2"
        case (records, filter (("span-a" ==) . (.name)) spans, filter (("span-b" ==) . (.name)) spans) of
            ([recordA, recordB], [spanA], [spanB]) -> do
                (recordA.context <&> (.spanId)) `shouldBe` Just spanA.context.spanId
                (recordB.context <&> (.spanId)) `shouldBe` Just spanB.context.spanId
            _ -> expectationFailure "expected two records, one span-a and one span-b"

    it "concurrent log emissions are all collected" do
        let n = 50 :: Int
        (_, records) <-
            runConcurrent
                . runNoTracing
                . runInMemoryLogging
                . replicateConcurrently_ n
                . info
                $ String "test"
        length records `shouldBe` n

    it "concurrent logging within spans preserves context" do
        (_, records) <-
            runConcurrent
                . runNoTracing
                . runInMemoryLogging
                . inSpan "parent" Span.Kind.Internal mempty
                . replicateConcurrently_ 10
                . info
                $ String "test"
        length records `shouldBe` 10
        mapM_ ((`shouldSatisfy` isJust) . (.context)) records