{- | IO lifecycle effects for the same constructor used in pure State.
Each raw read is timed where it happens and traced as one of the backend's
own exchanges; opening and closing a session are traced too. The sink keeps
the raw evidence a receipt records, which no trace carries.
-}
module Singular.Provider.Koios.Runtime (newIORuntime, koiosSource) where

import Control.Exception (finally, mask)
import Control.Tracer (Tracer, traceWith)
import Data.IORef (atomicModifyIORef', newIORef, readIORef)
import Data.Set qualified as Set
import Data.Text qualified as Text
import Singular.Provider.Koios.Provider
    ( ProviderEvent (..)
    , ProviderRuntime (..)
    )
import Singular.Registry.Evidence (SessionId (..))
import Singular.Registry.Trace
    ( BackendEvent (..)
    , Query (..)
    , QueryEnd (..)
    , ViewOpening (..)
    , ViewRelease (..)
    , isoNow
    , timedTrace
    )

-- | The source Koios's exchanges and reads report as.
koiosSource :: Text.Text
koiosSource :: Text
koiosSource = Text
"Koios"

{- | The sink retains raw evidence for receipts. The tracer records names,
identities, durations and failure classes, without raw bodies, error text
or keys.
-}
newIORuntime
    :: Tracer IO BackendEvent
    -> (ProviderEvent -> IO ())
    -> IO (ProviderRuntime IO)
newIORuntime :: Tracer IO BackendEvent
-> (ProviderEvent -> IO ()) -> IO (ProviderRuntime IO)
newIORuntime Tracer IO BackendEvent
tracer ProviderEvent -> IO ()
sink = do
    prefix <- IO Text
isoNow
    state <- newIORef (0 :: Integer, Set.empty)
    let identityText (SessionId Text
identity) = Text
identity
        observe ProviderEvent
event = do
            ProviderEvent -> IO ()
sink ProviderEvent
event
            case ProviderEvent
event of
                SessionOpened SessionId
identity Network
_ ->
                    Tracer IO BackendEvent -> BackendEvent -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO BackendEvent
tracer (BackendEvent -> IO ())
-> (ViewOpening -> BackendEvent) -> ViewOpening -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewOpening -> BackendEvent
BackendViewOpened (ViewOpening -> IO ()) -> ViewOpening -> IO ()
forall a b. (a -> b) -> a -> b
$
                        Text -> Text -> ViewOpening
SessionViewOpened (SessionId -> Text
identityText SessionId
identity) Text
"Unbound"
                SessionClosed SessionId
identity ->
                    Tracer IO BackendEvent -> BackendEvent -> IO ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer IO BackendEvent
tracer (BackendEvent -> IO ())
-> (ViewRelease -> BackendEvent) -> ViewRelease -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ViewRelease -> BackendEvent
BackendViewReleased (ViewRelease -> IO ()) -> ViewRelease -> IO ()
forall a b. (a -> b) -> a -> b
$
                        Text -> ViewRelease
SessionViewClosed (SessionId -> Text
identityText SessionId
identity)
                ProviderEvent
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    pure
        ProviderRuntime
            { scopedSession = \SessionId -> IO a
action SessionId -> IO ()
release -> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
                identity <- IORef (Integer, Set SessionId)
-> ((Integer, Set SessionId)
    -> ((Integer, Set SessionId), SessionId))
-> IO SessionId
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef (Integer, Set SessionId)
state (((Integer, Set SessionId)
  -> ((Integer, Set SessionId), SessionId))
 -> IO SessionId)
-> ((Integer, Set SessionId)
    -> ((Integer, Set SessionId), SessionId))
-> IO SessionId
forall a b. (a -> b) -> a -> b
$ \(Integer
number, Set SessionId
open) ->
                    let allocated :: SessionId
allocated = Text -> SessionId
SessionId (Text
"koios-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
prefix Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Integer -> String
forall a. Show a => a -> String
show Integer
number))
                    in  ((Integer
number Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, SessionId -> Set SessionId -> Set SessionId
forall a. Ord a => a -> Set a -> Set a
Set.insert SessionId
allocated Set SessionId
open), SessionId
allocated)
                restore (action identity)
                    `finally` ( release identity
                                    `finally` atomicModifyIORef'
                                        state
                                        (\(Integer
number, Set SessionId
open) -> ((Integer
number, SessionId -> Set SessionId -> Set SessionId
forall a. Ord a => a -> Set a -> Set a
Set.delete SessionId
identity Set SessionId
open), ()))
                              )
            , sessionOpen = \SessionId
identity -> SessionId -> Set SessionId -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member SessionId
identity (Set SessionId -> Bool)
-> ((Integer, Set SessionId) -> Set SessionId)
-> (Integer, Set SessionId)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer, Set SessionId) -> Set SessionId
forall a b. (a, b) -> b
snd ((Integer, Set SessionId) -> Bool)
-> IO (Integer, Set SessionId) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef (Integer, Set SessionId) -> IO (Integer, Set SessionId)
forall a. IORef a -> IO a
readIORef IORef (Integer, Set SessionId)
state
            , recordEvent = observe
            , measureRead = \SessionId
identity Text
name a -> ProviderEvent
event IO a
action ->
                Tracer IO BackendEvent
-> (Double -> Either ErrorClass a -> BackendEvent) -> IO a -> IO a
forall e a.
Tracer IO e -> (Double -> Either ErrorClass a -> e) -> IO a -> IO a
timedTrace
                    Tracer IO BackendEvent
tracer
                    ( \Double
ms Either ErrorClass a
end ->
                        Query -> BackendEvent
Exchanged
                            Query
                                { queryName :: Text
queryName = Text
name
                                , querySource :: Text
querySource = Text
koiosSource
                                , querySession :: Maybe Text
querySession = Text -> Maybe Text
forall a. a -> Maybe a
Just (SessionId -> Text
identityText SessionId
identity)
                                , queryElapsed :: Double
queryElapsed = Double
ms
                                , queryEnd :: QueryEnd
queryEnd = (ErrorClass -> QueryEnd)
-> (a -> QueryEnd) -> Either ErrorClass a -> QueryEnd
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ErrorClass -> QueryEnd
QueryFailed (QueryEnd -> a -> QueryEnd
forall a b. a -> b -> a
const (Maybe Int -> QueryEnd
Answered Maybe Int
forall a. Maybe a
Nothing)) Either ErrorClass a
end
                                }
                    )
                    (do result <- IO a
action; sink (event result); pure result)
            }