-- | The internals of Workflow handles. They are exposed here primarily for interceptor implementations.
module Temporal.Workflow.Unsafe.Handle where

import Control.Monad.Reader
import qualified Data.HashMap.Strict as HashMap
import Data.Kind
import Data.ProtoLens
import Lens.Family2
import qualified Proto.Temporal.Sdk.Core.ChildWorkflow.ChildWorkflow as ChildWorkflow
import qualified Proto.Temporal.Sdk.Core.ChildWorkflow.ChildWorkflow_Fields as ChildWorkflow
import qualified Proto.Temporal.Sdk.Core.Common.Common_Fields as Common
import qualified Proto.Temporal.Sdk.Core.WorkflowActivation.WorkflowActivation_Fields as Activation
import qualified Proto.Temporal.Sdk.Core.WorkflowCommands.WorkflowCommands_Fields as Command
import RequireCallStack
import Temporal.Common
import Temporal.Exception
import Temporal.Payload
import Temporal.Workflow.Internal.Instance
import Temporal.Workflow.Internal.Monad
import UnliftIO


{- | Some tasks in a Workflow return a handle that can be used to wait for the task to complete.

This class provides a common interface for waiting on these handles.
-}
class Wait h where
  type WaitResult h :: Type


  -- | Wait for a handle on an an action to complete.
  wait :: RequireCallStack => h -> WaitResult h


{- | Some tasks in a Workflow return a handle that can be used to cancel a task.

This class provides a common interface for performing cancellation on these handles.
-}
class Cancel h where
  type CancelResult h :: Type


  -- | Signal to Temporal that a handle representing an async action should be cancelled.
  cancel :: RequireCallStack => h -> CancelResult h


instance Wait (Task a) where
  type WaitResult (Task a) = Workflow a
  wait :: RequireCallStack => Task a -> WaitResult (Task a)
wait Task a
t = do
    Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
    Task a
t.waitAction


instance Cancel (Task a) where
  type CancelResult (Task a) = Workflow ()
  cancel :: RequireCallStack => Task a -> CancelResult (Task a)
cancel Task a
t = do
    Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
    Task a
t.cancelAction


{- | Returns an action that can be used to await cancellation of an external workflow.

Throws 'CancelExternalWorkflowFailed' if the cancellation request failed.
-}
instance Cancel (ExternalWorkflowHandle a) where
  type CancelResult (ExternalWorkflowHandle a) = Workflow (Workflow ())


  cancel :: RequireCallStack =>
ExternalWorkflowHandle a -> CancelResult (ExternalWorkflowHandle a)
cancel ExternalWorkflowHandle a
h = InstanceM (Workflow ()) -> Workflow (Workflow ())
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM (Workflow ()) -> Workflow (Workflow ()))
-> InstanceM (Workflow ()) -> Workflow (Workflow ())
forall a b. (a -> b) -> a -> b
$ do
    inst <- InstanceM WorkflowInstance
forall r (m :: * -> *). MonadReader r m => m r
ask
    s@(Sequence sVal) <- nextExternalSignalSequence
    res <- newIVar
    atomically $ modifyTVar' inst.workflowSequenceMaps $ \SequenceMaps
seqMaps ->
      SequenceMaps
seqMaps {externalSignals = HashMap.insert s res (externalSignals seqMaps)}
    addCommand
      ( defMessage
          & Command.requestCancelExternalWorkflowExecution
            .~ ( defMessage
                  & Command.seq .~ sVal
                  & Command.workflowExecution
                    .~ ( defMessage
                          & Common.workflowId .~ rawWorkflowId h.externalWorkflowWorkflowId
                          & Common.runId .~ maybe "" rawRunId h.externalWorkflowRunId
                       )
               )
      )
    pure $ do
      res' <- getIVar res
      case res' ^. Activation.maybe'failure of
        Maybe Failure
Nothing -> () -> Workflow ()
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Failure
f -> CancelExternalWorkflowFailed -> Workflow ()
forall e a. (HasCallStack, Exception e) => e -> Workflow a
throw (CancelExternalWorkflowFailed -> Workflow ())
-> CancelExternalWorkflowFailed -> Workflow ()
forall a b. (a -> b) -> a -> b
$ Failure -> CancelExternalWorkflowFailed
CancelExternalWorkflowFailed Failure
f


instance Wait (ChildWorkflowHandle a) where
  type WaitResult (ChildWorkflowHandle a) = Workflow a
  wait :: RequireCallStack =>
ChildWorkflowHandle a -> WaitResult (ChildWorkflowHandle a)
wait = ChildWorkflowHandle a -> Workflow a
ChildWorkflowHandle a -> WaitResult (ChildWorkflowHandle a)
forall result.
RequireCallStack =>
ChildWorkflowHandle result -> Workflow result
waitChildWorkflowResult


waitChildWorkflowStart :: RequireCallStack => ChildWorkflowHandle result -> Workflow ()
waitChildWorkflowStart :: forall result.
RequireCallStack =>
ChildWorkflowHandle result -> Workflow ()
waitChildWorkflowStart ChildWorkflowHandle result
wfHandle = do
  Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
  IVar () -> Workflow ()
forall a. IVar a -> Workflow a
getIVar ChildWorkflowHandle result
wfHandle.startHandle


waitChildWorkflowResult :: RequireCallStack => ChildWorkflowHandle result -> Workflow result
waitChildWorkflowResult :: forall result.
RequireCallStack =>
ChildWorkflowHandle result -> Workflow result
waitChildWorkflowResult wfHandle :: ChildWorkflowHandle result
wfHandle@(ChildWorkflowHandle {Payload -> IO result
childWorkflowResultConverter :: Payload -> IO result
childWorkflowResultConverter :: forall result. ChildWorkflowHandle result -> Payload -> IO result
childWorkflowResultConverter}) =
  ChildWorkflowHandle result -> Workflow ()
forall result.
RequireCallStack =>
ChildWorkflowHandle result -> Workflow ()
waitChildWorkflowStart ChildWorkflowHandle result
wfHandle Workflow () -> Workflow result -> Workflow result
forall a b. Workflow a -> Workflow b -> Workflow b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> do
    Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
    res <- IVar ResolveChildWorkflowExecution
-> Workflow ResolveChildWorkflowExecution
forall a. IVar a -> Workflow a
getIVar ChildWorkflowHandle result
wfHandle.resultHandle
    case res ^. Activation.result . ChildWorkflow.maybe'status of
      Maybe ChildWorkflowResult'Status
Nothing -> InstanceM result -> Workflow result
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM result -> Workflow result)
-> InstanceM result -> Workflow result
forall a b. (a -> b) -> a -> b
$ RuntimeError -> InstanceM result
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO (RuntimeError -> InstanceM result)
-> RuntimeError -> InstanceM result
forall a b. (a -> b) -> a -> b
$ String -> RuntimeError
RuntimeError String
"Unrecognized child workflow result status"
      Just ChildWorkflowResult'Status
s -> case ChildWorkflowResult'Status
s of
        ChildWorkflow.ChildWorkflowResult'Completed Success
res' -> do
          eVal <- InstanceM (Either SomeException result)
-> Workflow (Either SomeException result)
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM (Either SomeException result)
 -> Workflow (Either SomeException result))
-> InstanceM (Either SomeException result)
-> Workflow (Either SomeException result)
forall a b. (a -> b) -> a -> b
$ IO (Either SomeException result)
-> InstanceM (Either SomeException result)
forall a. IO a -> InstanceM a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either SomeException result)
 -> InstanceM (Either SomeException result))
-> IO (Either SomeException result)
-> InstanceM (Either SomeException result)
forall a b. (a -> b) -> a -> b
$ IO result -> IO (Either SomeException result)
forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try (IO result -> IO (Either SomeException result))
-> IO result -> IO (Either SomeException result)
forall a b. (a -> b) -> a -> b
$ Payload -> IO result
childWorkflowResultConverter (Payload -> IO result) -> Payload -> IO result
forall a b. (a -> b) -> a -> b
$ Payload -> Payload
convertFromProtoPayload (Payload -> Payload) -> Payload -> Payload
forall a b. (a -> b) -> a -> b
$ Success
res' Success
-> FoldLike Payload Success Success Payload Payload -> Payload
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Payload Success Success Payload Payload
forall (f :: * -> *) s a.
(Functor f, HasField s "result" a) =>
LensLike' f s a
ChildWorkflow.result
          case eVal of
            Left SomeException
err -> SomeException -> Workflow result
forall e a. (HasCallStack, Exception e) => e -> Workflow a
throw (SomeException
err :: SomeException)
            Right result
ok -> result -> Workflow result
forall a. a -> Workflow a
forall (f :: * -> *) a. Applicative f => a -> f a
pure result
ok
        ChildWorkflow.ChildWorkflowResult'Failed Failure
res' -> ChildWorkflowFailed -> Workflow result
forall e a. (HasCallStack, Exception e) => e -> Workflow a
throw (ChildWorkflowFailed -> Workflow result)
-> ChildWorkflowFailed -> Workflow result
forall a b. (a -> b) -> a -> b
$ Failure -> ChildWorkflowFailed
ChildWorkflowFailed (Failure -> ChildWorkflowFailed) -> Failure -> ChildWorkflowFailed
forall a b. (a -> b) -> a -> b
$ Failure
res' Failure
-> FoldLike Failure Failure Failure Failure Failure -> Failure
forall s a t b. s -> FoldLike a s t a b -> a
^. FoldLike Failure Failure Failure Failure Failure
forall (f :: * -> *) s a.
(Functor f, HasField s "failure" a) =>
LensLike' f s a
ChildWorkflow.failure
        ChildWorkflow.ChildWorkflowResult'Cancelled Cancellation
_ -> ChildWorkflowCancelled -> Workflow result
forall e a. (HasCallStack, Exception e) => e -> Workflow a
throw ChildWorkflowCancelled
ChildWorkflowCancelled


instance Cancel (ChildWorkflowHandle a) where
  type CancelResult (ChildWorkflowHandle a) = Workflow ()
  cancel :: RequireCallStack =>
ChildWorkflowHandle a -> CancelResult (ChildWorkflowHandle a)
cancel ChildWorkflowHandle a
h = do
    Workflow ()
RequireCallStack => Workflow ()
updateCallStackW
    ChildWorkflowHandle a -> Workflow ()
forall result.
RequireCallStack =>
ChildWorkflowHandle result -> Workflow ()
cancelChildWorkflowExecution ChildWorkflowHandle a
h


cancelChildWorkflowExecution :: RequireCallStack => ChildWorkflowHandle result -> Workflow ()
cancelChildWorkflowExecution :: forall result.
RequireCallStack =>
ChildWorkflowHandle result -> Workflow ()
cancelChildWorkflowExecution ChildWorkflowHandle {Sequence
childWorkflowSequence :: Sequence
childWorkflowSequence :: forall result. ChildWorkflowHandle result -> Sequence
childWorkflowSequence} = InstanceM () -> Workflow ()
forall a. RequireCallStack => InstanceM a -> Workflow a
ilift (InstanceM () -> Workflow ()) -> InstanceM () -> Workflow ()
forall a b. (a -> b) -> a -> b
$ do
  InstanceM ()
RequireCallStack => InstanceM ()
updateCallStack
  -- I don't see a way to block on this? I guess Temporal wants us to rely on the orchestrator
  -- managing the cancellation. Compare with ResolveRequestCancelExternalWorkflow. I think
  -- external workflows need a resolution step because they may not even exist.
  WorkflowCommand -> InstanceM ()
addCommand (WorkflowCommand -> InstanceM ())
-> WorkflowCommand -> InstanceM ()
forall a b. (a -> b) -> a -> b
$
    WorkflowCommand
forall msg. Message msg => msg
defMessage
      WorkflowCommand
-> (WorkflowCommand -> WorkflowCommand) -> WorkflowCommand
forall s t. s -> (s -> t) -> t
& LensLike' f WorkflowCommand CancelChildWorkflowExecution
forall {f :: * -> *}.
Identical f =>
LensLike' f WorkflowCommand CancelChildWorkflowExecution
forall (f :: * -> *) s a.
(Functor f, HasField s "cancelChildWorkflowExecution" a) =>
LensLike' f s a
Command.cancelChildWorkflowExecution
        (forall {f :: * -> *}.
 Identical f =>
 LensLike' f WorkflowCommand CancelChildWorkflowExecution)
-> CancelChildWorkflowExecution
-> WorkflowCommand
-> WorkflowCommand
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( CancelChildWorkflowExecution
forall msg. Message msg => msg
defMessage
              CancelChildWorkflowExecution
-> (CancelChildWorkflowExecution -> CancelChildWorkflowExecution)
-> CancelChildWorkflowExecution
forall s t. s -> (s -> t) -> t
& LensLike' f CancelChildWorkflowExecution Word32
forall {f :: * -> *}.
Identical f =>
LensLike' f CancelChildWorkflowExecution Word32
forall (f :: * -> *) s a.
(Functor f, HasField s "childWorkflowSeq" a) =>
LensLike' f s a
Command.childWorkflowSeq (forall {f :: * -> *}.
 Identical f =>
 LensLike' f CancelChildWorkflowExecution Word32)
-> Word32
-> CancelChildWorkflowExecution
-> CancelChildWorkflowExecution
forall s t a b. Setter s t a b -> b -> s -> t
.~ Sequence -> Word32
rawSequence Sequence
childWorkflowSequence
           )