{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Temporal.Worker.Types where

import Control.Monad.Logger
import Control.Monad.Reader
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import OpenTelemetry.Trace.Core
import Temporal.Activity.Definition (ActivityDefinition)
import Temporal.Activity.Worker (ActivityWorker)
import Temporal.Common
import Temporal.Core.Worker (InactiveForReplay)
import qualified Temporal.Core.Worker as Core
import Temporal.Exception (ApplicationFailureHandler)
import Temporal.Interceptor
import Temporal.Payload
import Temporal.Workflow.Definition (WorkflowDefinition)
import Temporal.Workflow.Internal.Monad
import Temporal.Workflow.Worker (WorkflowWorker)
import UnliftIO hiding (race)


data WorkerConfig activityEnv = WorkerConfig
  { forall activityEnv. WorkerConfig activityEnv -> Maybe Int
deadlockTimeout :: Maybe Int
  , forall activityEnv.
WorkerConfig activityEnv -> HashMap Text WorkflowDefinition
wfDefs :: HashMap Text WorkflowDefinition
  , forall activityEnv. WorkerConfig activityEnv -> activityEnv
actEnv :: activityEnv
  , forall activityEnv.
WorkerConfig activityEnv
-> HashMap Text (ActivityDefinition activityEnv)
actDefs :: HashMap Text (ActivityDefinition activityEnv)
  , forall activityEnv. WorkerConfig activityEnv -> WorkerConfig
coreConfig :: Core.WorkerConfig
  , forall activityEnv.
WorkerConfig activityEnv -> Interceptors activityEnv
interceptorConfig :: Interceptors activityEnv
  , forall activityEnv.
WorkerConfig activityEnv -> [ApplicationFailureHandler]
applicationErrorConverters :: [ApplicationFailureHandler]
  , forall activityEnv. WorkerConfig activityEnv -> TracerProvider
tracerProvider :: TracerProvider
  -- ^ This TracerProvider should only need to be supplied if you want to observe
  -- Worker-internal traces for debugging purposes.
  , forall activityEnv.
WorkerConfig activityEnv
-> Loc -> Text -> LogLevel -> LogStr -> IO ()
logger :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
  , forall activityEnv. WorkerConfig activityEnv -> PayloadProcessor
payloadProcessor :: PayloadProcessor
  }


data Worker (ty :: Core.WorkerType) activityEnv = Worker
  { forall (ty :: WorkerType) activityEnv.
Worker ty activityEnv -> Worker ty
workerCore :: Core.Worker ty
  , forall (ty :: WorkerType) activityEnv.
Worker ty activityEnv -> TaskQueue
workerTaskQueue :: TaskQueue
  , forall (ty :: WorkerType) activityEnv.
Worker ty activityEnv -> WorkerConfig activityEnv
workerConfig :: WorkerConfig activityEnv
  , forall (ty :: WorkerType) activityEnv.
Worker ty activityEnv -> Loc -> Text -> LogLevel -> LogStr -> IO ()
workerLogFn :: Loc -> LogSource -> LogLevel -> LogStr -> IO ()
  , forall (ty :: WorkerType) activityEnv.
Worker ty activityEnv -> WorkflowWorker
workflowWorker :: WorkflowWorker
  , forall (ty :: WorkerType) activityEnv.
Worker ty activityEnv
-> InactiveForReplay ty (ActivityWorker activityEnv)
activityWorker :: InactiveForReplay ty (ActivityWorker activityEnv)
  }


newtype WorkerM ty activityEnv a = WorkerM {forall (ty :: WorkerType) activityEnv a.
WorkerM ty activityEnv a -> ReaderT (Worker ty activityEnv) IO a
unWorkerM :: ReaderT (Worker ty activityEnv) IO a}
  deriving newtype ((forall a b.
 (a -> b) -> WorkerM ty activityEnv a -> WorkerM ty activityEnv b)
-> (forall a b.
    a -> WorkerM ty activityEnv b -> WorkerM ty activityEnv a)
-> Functor (WorkerM ty activityEnv)
forall a b.
a -> WorkerM ty activityEnv b -> WorkerM ty activityEnv a
forall a b.
(a -> b) -> WorkerM ty activityEnv a -> WorkerM ty activityEnv b
forall (ty :: WorkerType) activityEnv a b.
a -> WorkerM ty activityEnv b -> WorkerM ty activityEnv a
forall (ty :: WorkerType) activityEnv a b.
(a -> b) -> WorkerM ty activityEnv a -> WorkerM ty activityEnv b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (ty :: WorkerType) activityEnv a b.
(a -> b) -> WorkerM ty activityEnv a -> WorkerM ty activityEnv b
fmap :: forall a b.
(a -> b) -> WorkerM ty activityEnv a -> WorkerM ty activityEnv b
$c<$ :: forall (ty :: WorkerType) activityEnv a b.
a -> WorkerM ty activityEnv b -> WorkerM ty activityEnv a
<$ :: forall a b.
a -> WorkerM ty activityEnv b -> WorkerM ty activityEnv a
Functor, Functor (WorkerM ty activityEnv)
Functor (WorkerM ty activityEnv) =>
(forall a. a -> WorkerM ty activityEnv a)
-> (forall a b.
    WorkerM ty activityEnv (a -> b)
    -> WorkerM ty activityEnv a -> WorkerM ty activityEnv b)
-> (forall a b c.
    (a -> b -> c)
    -> WorkerM ty activityEnv a
    -> WorkerM ty activityEnv b
    -> WorkerM ty activityEnv c)
-> (forall a b.
    WorkerM ty activityEnv a
    -> WorkerM ty activityEnv b -> WorkerM ty activityEnv b)
-> (forall a b.
    WorkerM ty activityEnv a
    -> WorkerM ty activityEnv b -> WorkerM ty activityEnv a)
-> Applicative (WorkerM ty activityEnv)
forall a. a -> WorkerM ty activityEnv a
forall a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv a
forall a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv b
forall a b.
WorkerM ty activityEnv (a -> b)
-> WorkerM ty activityEnv a -> WorkerM ty activityEnv b
forall a b c.
(a -> b -> c)
-> WorkerM ty activityEnv a
-> WorkerM ty activityEnv b
-> WorkerM ty activityEnv c
forall (ty :: WorkerType) activityEnv.
Functor (WorkerM ty activityEnv)
forall (ty :: WorkerType) activityEnv a.
a -> WorkerM ty activityEnv a
forall (ty :: WorkerType) activityEnv a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv a
forall (ty :: WorkerType) activityEnv a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv b
forall (ty :: WorkerType) activityEnv a b.
WorkerM ty activityEnv (a -> b)
-> WorkerM ty activityEnv a -> WorkerM ty activityEnv b
forall (ty :: WorkerType) activityEnv a b c.
(a -> b -> c)
-> WorkerM ty activityEnv a
-> WorkerM ty activityEnv b
-> WorkerM ty activityEnv c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (ty :: WorkerType) activityEnv a.
a -> WorkerM ty activityEnv a
pure :: forall a. a -> WorkerM ty activityEnv a
$c<*> :: forall (ty :: WorkerType) activityEnv a b.
WorkerM ty activityEnv (a -> b)
-> WorkerM ty activityEnv a -> WorkerM ty activityEnv b
<*> :: forall a b.
WorkerM ty activityEnv (a -> b)
-> WorkerM ty activityEnv a -> WorkerM ty activityEnv b
$cliftA2 :: forall (ty :: WorkerType) activityEnv a b c.
(a -> b -> c)
-> WorkerM ty activityEnv a
-> WorkerM ty activityEnv b
-> WorkerM ty activityEnv c
liftA2 :: forall a b c.
(a -> b -> c)
-> WorkerM ty activityEnv a
-> WorkerM ty activityEnv b
-> WorkerM ty activityEnv c
$c*> :: forall (ty :: WorkerType) activityEnv a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv b
*> :: forall a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv b
$c<* :: forall (ty :: WorkerType) activityEnv a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv a
<* :: forall a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv a
Applicative, Applicative (WorkerM ty activityEnv)
Applicative (WorkerM ty activityEnv) =>
(forall a b.
 WorkerM ty activityEnv a
 -> (a -> WorkerM ty activityEnv b) -> WorkerM ty activityEnv b)
-> (forall a b.
    WorkerM ty activityEnv a
    -> WorkerM ty activityEnv b -> WorkerM ty activityEnv b)
-> (forall a. a -> WorkerM ty activityEnv a)
-> Monad (WorkerM ty activityEnv)
forall a. a -> WorkerM ty activityEnv a
forall a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv b
forall a b.
WorkerM ty activityEnv a
-> (a -> WorkerM ty activityEnv b) -> WorkerM ty activityEnv b
forall (ty :: WorkerType) activityEnv.
Applicative (WorkerM ty activityEnv)
forall (ty :: WorkerType) activityEnv a.
a -> WorkerM ty activityEnv a
forall (ty :: WorkerType) activityEnv a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv b
forall (ty :: WorkerType) activityEnv a b.
WorkerM ty activityEnv a
-> (a -> WorkerM ty activityEnv b) -> WorkerM ty activityEnv b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (ty :: WorkerType) activityEnv a b.
WorkerM ty activityEnv a
-> (a -> WorkerM ty activityEnv b) -> WorkerM ty activityEnv b
>>= :: forall a b.
WorkerM ty activityEnv a
-> (a -> WorkerM ty activityEnv b) -> WorkerM ty activityEnv b
$c>> :: forall (ty :: WorkerType) activityEnv a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv b
>> :: forall a b.
WorkerM ty activityEnv a
-> WorkerM ty activityEnv b -> WorkerM ty activityEnv b
$creturn :: forall (ty :: WorkerType) activityEnv a.
a -> WorkerM ty activityEnv a
return :: forall a. a -> WorkerM ty activityEnv a
Monad, Monad (WorkerM ty activityEnv)
Monad (WorkerM ty activityEnv) =>
(forall a. IO a -> WorkerM ty activityEnv a)
-> MonadIO (WorkerM ty activityEnv)
forall a. IO a -> WorkerM ty activityEnv a
forall (ty :: WorkerType) activityEnv.
Monad (WorkerM ty activityEnv)
forall (ty :: WorkerType) activityEnv a.
IO a -> WorkerM ty activityEnv a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall (ty :: WorkerType) activityEnv a.
IO a -> WorkerM ty activityEnv a
liftIO :: forall a. IO a -> WorkerM ty activityEnv a
MonadIO, MonadReader (Worker ty activityEnv), MonadIO (WorkerM ty activityEnv)
MonadIO (WorkerM ty activityEnv) =>
(forall b.
 ((forall a. WorkerM ty activityEnv a -> IO a) -> IO b)
 -> WorkerM ty activityEnv b)
-> MonadUnliftIO (WorkerM ty activityEnv)
forall b.
((forall a. WorkerM ty activityEnv a -> IO a) -> IO b)
-> WorkerM ty activityEnv b
forall (ty :: WorkerType) activityEnv.
MonadIO (WorkerM ty activityEnv)
forall (ty :: WorkerType) activityEnv b.
((forall a. WorkerM ty activityEnv a -> IO a) -> IO b)
-> WorkerM ty activityEnv b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall (ty :: WorkerType) activityEnv b.
((forall a. WorkerM ty activityEnv a -> IO a) -> IO b)
-> WorkerM ty activityEnv b
withRunInIO :: forall b.
((forall a. WorkerM ty activityEnv a -> IO a) -> IO b)
-> WorkerM ty activityEnv b
MonadUnliftIO)


instance MonadLogger (WorkerM ty activityEnv) where
  monadLoggerLog :: forall msg.
ToLogStr msg =>
Loc -> Text -> LogLevel -> msg -> WorkerM ty activityEnv ()
monadLoggerLog Loc
loc Text
src LogLevel
level msg
msg = do
    worker <- WorkerM ty activityEnv (Worker ty activityEnv)
forall r (m :: * -> *). MonadReader r m => m r
ask
    liftIO $ worker.workerLogFn loc src level (toLogStr msg)


instance MonadLoggerIO (WorkerM ty activityEnv) where
  askLoggerIO :: WorkerM ty activityEnv (Loc -> Text -> LogLevel -> LogStr -> IO ())
askLoggerIO = do
    worker <- WorkerM ty activityEnv (Worker ty activityEnv)
forall r (m :: * -> *). MonadReader r m => m r
ask
    pure worker.workerLogFn


{- | Values that were blocking waiting for an activation, and have now
been unblocked.  The worker adds these to a queue ('activationResults') using
'putResult'; the scheduler collects them from the queue and unblocks
the relevant computations.
-}
data ActivationResult
  = forall a.
    ActivationResult
      (ResultVal a)
      !(IVar a)


runWorkerM :: Worker ty actEnv -> WorkerM ty actEnv a -> IO a
runWorkerM :: forall (ty :: WorkerType) actEnv a.
Worker ty actEnv -> WorkerM ty actEnv a -> IO a
runWorkerM Worker ty actEnv
worker WorkerM ty actEnv a
m = ReaderT (Worker ty actEnv) IO a -> Worker ty actEnv -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WorkerM ty actEnv a -> ReaderT (Worker ty actEnv) IO a
forall (ty :: WorkerType) activityEnv a.
WorkerM ty activityEnv a -> ReaderT (Worker ty activityEnv) IO a
unWorkerM WorkerM ty actEnv a
m) Worker ty actEnv
worker