never executed always true always false

    1 module PureClaw.Transcript.Combinator
    2   ( withTranscript
    3   ) where
    4 
    5 import Control.Exception
    6 import Data.Aeson qualified as Aeson
    7 import Data.ByteString (ByteString)
    8 import Data.Map.Strict qualified as Map
    9 import Data.Text (Text)
   10 import Data.Text qualified as T
   11 import Data.Time
   12 import Data.UUID qualified as UUID
   13 import Data.UUID.V4 qualified as UUID
   14 
   15 import PureClaw.Handles.Transcript
   16 import PureClaw.Transcript.Types
   17 
   18 -- | Wrap a @ByteString -> IO ByteString@ function with automatic transcript
   19 -- logging. Records a 'Request' entry before the call and a 'Response' entry
   20 -- after, linked by a shared correlation UUID. Exceptions from the wrapped
   21 -- function are caught, logged with @"error"@ metadata, and re-thrown.
   22 -- Transcript write failures are silently dropped so the actual call result
   23 -- always takes priority over logging.
   24 withTranscript
   25   :: TranscriptHandle
   26   -> Maybe Text                    -- ^ harness name (Nothing if direct)
   27   -> Maybe Text                    -- ^ model name (Nothing if unknown)
   28   -> (ByteString -> IO ByteString) -- ^ raw call
   29   -> ByteString                    -- ^ input
   30   -> IO ByteString                 -- ^ output (also logged)
   31 withTranscript th harness model fn input = do
   32   correlationId <- UUID.toText <$> UUID.nextRandom
   33   entryId1 <- UUID.toText <$> UUID.nextRandom
   34   startTime <- getCurrentTime
   35 
   36   let reqEntry = TranscriptEntry
   37         { _te_id            = entryId1
   38         , _te_timestamp     = startTime
   39         , _te_harness       = harness
   40         , _te_model         = model
   41         , _te_direction     = Request
   42         , _te_payload       = encodePayload input
   43         , _te_durationMs    = Nothing
   44         , _te_correlationId = correlationId
   45         , _te_metadata      = Map.empty
   46         }
   47 
   48   -- Record request; swallow transcript write failures
   49   safeRecord th reqEntry
   50 
   51   -- Call the wrapped function, catching exceptions
   52   result <- try (fn input)
   53 
   54   endTime <- getCurrentTime
   55   let durationMs = utcTimeToDurationMs startTime endTime
   56   entryId2 <- UUID.toText <$> UUID.nextRandom
   57 
   58   case result of
   59     Right output -> do
   60       let respEntry = TranscriptEntry
   61             { _te_id            = entryId2
   62             , _te_timestamp     = endTime
   63             , _te_harness       = harness
   64         , _te_model         = model
   65             , _te_direction     = Response
   66             , _te_payload       = encodePayload output
   67             , _te_durationMs    = Just durationMs
   68             , _te_correlationId = correlationId
   69             , _te_metadata      = Map.empty
   70             }
   71       safeRecord th respEntry
   72       pure output
   73 
   74     Left (ex :: SomeException) -> do
   75       let respEntry = TranscriptEntry
   76             { _te_id            = entryId2
   77             , _te_timestamp     = endTime
   78             , _te_harness       = harness
   79         , _te_model         = model
   80             , _te_direction     = Response
   81             , _te_payload       = encodePayload mempty
   82             , _te_durationMs    = Just durationMs
   83             , _te_correlationId = correlationId
   84             , _te_metadata      = Map.singleton "error" (Aeson.String (T.pack (show ex)))
   85             }
   86       safeRecord th respEntry
   87       throwIO ex
   88 
   89 -- | Record an entry, silently dropping any exceptions from the transcript handle.
   90 safeRecord :: TranscriptHandle -> TranscriptEntry -> IO ()
   91 safeRecord th entry =
   92   _th_record th entry `catch` \(_ :: SomeException) -> pure ()
   93 
   94 -- | Compute duration in milliseconds between two UTCTimes.
   95 utcTimeToDurationMs :: UTCTime -> UTCTime -> Int
   96 utcTimeToDurationMs start end =
   97   let diffSec = realToFrac (diffUTCTime end start) :: Double
   98   in  round (diffSec * 1000)