{-# LANGUAGE DuplicateRecordFields #-}

module Temporal.Exception (
  module Temporal.Exception,
  ActivityType (..),
  RetryState (..),
) where

import Control.Applicative (Alternative (..))
import Control.Exception
import Control.Exception.Annotated
import Data.Annotation
import Data.Int
import Data.ProtoLens (Message (..))
import Data.Text
import Data.Typeable
import Data.Vector (Vector)
import GHC.Stack
import Lens.Family2
import qualified Proto.Temporal.Api.Common.V1.Message as Common
import qualified Proto.Temporal.Api.Common.V1.Message_Fields as Common
import Proto.Temporal.Api.Failure.V1.Message
import qualified Proto.Temporal.Api.Failure.V1.Message as F
import qualified Proto.Temporal.Api.Failure.V1.Message as Proto
import qualified Proto.Temporal.Api.Failure.V1.Message_Fields as F
import Proto.Temporal.Api.History.V1.Message
import System.IO.Unsafe (unsafePerformIO)
import Temporal.Common
import Temporal.Duration
import Temporal.Payload
import Temporal.Workflow.Types


---------------------------------------------------------------------
-- SDK failures

data SomeWorkerException = forall e. Exception e => SomeWorkerException e


instance Show SomeWorkerException where
  show :: SomeWorkerException -> String
show (SomeWorkerException e
e) = e -> String
forall a. Show a => a -> String
show e
e


instance Exception SomeWorkerException


workerExceptionToException :: Exception e => e -> SomeException
workerExceptionToException :: forall e. Exception e => e -> SomeException
workerExceptionToException = SomeWorkerException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeWorkerException -> SomeException)
-> (e -> SomeWorkerException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeWorkerException
forall e. Exception e => e -> SomeWorkerException
SomeWorkerException


workerExceptionFromException :: Exception e => SomeException -> Maybe e
workerExceptionFromException :: forall e. Exception e => SomeException -> Maybe e
workerExceptionFromException SomeException
x = do
  SomeWorkerException a <- SomeException -> Maybe SomeWorkerException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
  cast a


-- type SomeFailure = Failure (Maybe FailureInfo)

-- data Failure = Failure
--   { message :: Text
--   , source :: Text
--   , stackTrace :: Text
--   , encodedAttributes :: Maybe Payload
--   , cause :: Maybe Failure
--   , failureInfo :: Maybe FailureInfo
--   }

-- data FailureInfo
--   = ApplicationFailureInfo ApplicationFailure
--   | TimeoutFailureInfo TimeoutFailure
--   | CanceledFailureInfo CanceledFailure
--   | TerminatedFailureInfo TerminatedFailure
--   | ServerFailureInfo ServerFailure
--   | ResetWorkflowFailureInfo ResetWorkflowFailure
--   | ActivityFailureInfo ActivityFailure
--   | ChildWorkflowExecutionFailureInfo ChildWorkflowExecutionFailure

-- data ApplicationFailureInfo = ApplicationFailureInfo
--   { type' :: Text
--   , nonRetryable :: Bool
--   , details :: Vector Payload
--   }

-- data TimeoutFailureInfo = TimeoutFailureInfo
--   { timeoutType :: TimeoutTime
--   , lastHeartbeatDetails :: Vector Payload
--   }

-- data CanceledFailureInfo = CanceledFailureInfo
--   { details :: Vector Payload
--   }

-- data ResetWorkflowFailureInfo = ResetWorkflowFailureInfo
--   { lastHeartbeatDetails :: Vector Payload
--   }

-- data TerminatedFailure = TerminatedFailure

-- data ServerFailure = ServerFailure
--   { nonRetryable :: Bool
--   }

-- data ActivityFailure = ActivityFailure
--   { scheduledEventId :: Int64
--   , startedEventId :: Int64
--   , identity :: Text
--   , activityType :: ActivityType
--   , activityId :: ActivityId
--   , retryState :: RetryState
--   }

-- data ChildWorkflowExecutionFailure = ChildWorkflowExecutionFailure
--   { namespace :: Text
--   , workflowExecution :: WorkflowExecution
--   , workflowType :: WorkflowType
--   , initiatedEventId :: Int64
--   , startedEventId :: Int64
--   , retryState :: RetryState
--   }

{- | Errors that are an issue with the worker itself, not the workflow

These errors should cause the worker to exit, and imply an issue with the
SDK itself.
-}
data RuntimeError = RuntimeError String
  deriving stock (Int -> RuntimeError -> ShowS
[RuntimeError] -> ShowS
RuntimeError -> String
(Int -> RuntimeError -> ShowS)
-> (RuntimeError -> String)
-> ([RuntimeError] -> ShowS)
-> Show RuntimeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RuntimeError -> ShowS
showsPrec :: Int -> RuntimeError -> ShowS
$cshow :: RuntimeError -> String
show :: RuntimeError -> String
$cshowList :: [RuntimeError] -> ShowS
showList :: [RuntimeError] -> ShowS
Show)


instance Exception RuntimeError where
  toException :: RuntimeError -> SomeException
toException = RuntimeError -> SomeException
forall e. Exception e => e -> SomeException
workerExceptionToException
  fromException :: SomeException -> Maybe RuntimeError
fromException = SomeException -> Maybe RuntimeError
forall e. Exception e => SomeException -> Maybe e
workerExceptionFromException


-- | Errors that are the fault of the developer, not the SDK.
data WorkflowNotFound = WorkflowNotFound String
  deriving stock (Int -> WorkflowNotFound -> ShowS
[WorkflowNotFound] -> ShowS
WorkflowNotFound -> String
(Int -> WorkflowNotFound -> ShowS)
-> (WorkflowNotFound -> String)
-> ([WorkflowNotFound] -> ShowS)
-> Show WorkflowNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowNotFound -> ShowS
showsPrec :: Int -> WorkflowNotFound -> ShowS
$cshow :: WorkflowNotFound -> String
show :: WorkflowNotFound -> String
$cshowList :: [WorkflowNotFound] -> ShowS
showList :: [WorkflowNotFound] -> ShowS
Show)


instance Exception WorkflowNotFound where
  toException :: WorkflowNotFound -> SomeException
toException = WorkflowNotFound -> SomeException
forall e. Exception e => e -> SomeException
workerExceptionToException
  fromException :: SomeException -> Maybe WorkflowNotFound
fromException = SomeException -> Maybe WorkflowNotFound
forall e. Exception e => SomeException -> Maybe e
workerExceptionFromException


data ActivityNotFound = ActivityNotFound String
  deriving stock (Int -> ActivityNotFound -> ShowS
[ActivityNotFound] -> ShowS
ActivityNotFound -> String
(Int -> ActivityNotFound -> ShowS)
-> (ActivityNotFound -> String)
-> ([ActivityNotFound] -> ShowS)
-> Show ActivityNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityNotFound -> ShowS
showsPrec :: Int -> ActivityNotFound -> ShowS
$cshow :: ActivityNotFound -> String
show :: ActivityNotFound -> String
$cshowList :: [ActivityNotFound] -> ShowS
showList :: [ActivityNotFound] -> ShowS
Show)


instance Exception ActivityNotFound where
  toException :: ActivityNotFound -> SomeException
toException = ActivityNotFound -> SomeException
forall e. Exception e => e -> SomeException
workerExceptionToException
  fromException :: SomeException -> Maybe ActivityNotFound
fromException = SomeException -> Maybe ActivityNotFound
forall e. Exception e => SomeException -> Maybe e
workerExceptionFromException


data QueryNotFound = QueryNotFound String
  deriving stock (Int -> QueryNotFound -> ShowS
[QueryNotFound] -> ShowS
QueryNotFound -> String
(Int -> QueryNotFound -> ShowS)
-> (QueryNotFound -> String)
-> ([QueryNotFound] -> ShowS)
-> Show QueryNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryNotFound -> ShowS
showsPrec :: Int -> QueryNotFound -> ShowS
$cshow :: QueryNotFound -> String
show :: QueryNotFound -> String
$cshowList :: [QueryNotFound] -> ShowS
showList :: [QueryNotFound] -> ShowS
Show)


instance Exception QueryNotFound where
  toException :: QueryNotFound -> SomeException
toException = QueryNotFound -> SomeException
forall e. Exception e => e -> SomeException
workerExceptionToException
  fromException :: SomeException -> Maybe QueryNotFound
fromException = SomeException -> Maybe QueryNotFound
forall e. Exception e => SomeException -> Maybe e
workerExceptionFromException


---------------------------------------------------------------------
-- Workflow exceptions

data LogicBugType
  = ReadingCompletionsFailedRun
  | WorkflowActivationDeadlock
  deriving stock (Int -> LogicBugType -> ShowS
[LogicBugType] -> ShowS
LogicBugType -> String
(Int -> LogicBugType -> ShowS)
-> (LogicBugType -> String)
-> ([LogicBugType] -> ShowS)
-> Show LogicBugType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogicBugType -> ShowS
showsPrec :: Int -> LogicBugType -> ShowS
$cshow :: LogicBugType -> String
show :: LogicBugType -> String
$cshowList :: [LogicBugType] -> ShowS
showList :: [LogicBugType] -> ShowS
Show)


data LogicBug = LogicBug LogicBugType
  deriving stock (Int -> LogicBug -> ShowS
[LogicBug] -> ShowS
LogicBug -> String
(Int -> LogicBug -> ShowS)
-> (LogicBug -> String) -> ([LogicBug] -> ShowS) -> Show LogicBug
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogicBug -> ShowS
showsPrec :: Int -> LogicBug -> ShowS
$cshow :: LogicBug -> String
show :: LogicBug -> String
$cshowList :: [LogicBug] -> ShowS
showList :: [LogicBug] -> ShowS
Show)


instance Exception LogicBug


data WorkflowAlreadyStarted = WorkflowAlreadyStarted
  { WorkflowAlreadyStarted -> WorkflowId
workflowAlreadyStartedWorkflowId :: WorkflowId
  , WorkflowAlreadyStarted -> WorkflowType
workflowAlreadyStartedWorkflowType :: WorkflowType
  }
  deriving stock (Int -> WorkflowAlreadyStarted -> ShowS
[WorkflowAlreadyStarted] -> ShowS
WorkflowAlreadyStarted -> String
(Int -> WorkflowAlreadyStarted -> ShowS)
-> (WorkflowAlreadyStarted -> String)
-> ([WorkflowAlreadyStarted] -> ShowS)
-> Show WorkflowAlreadyStarted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowAlreadyStarted -> ShowS
showsPrec :: Int -> WorkflowAlreadyStarted -> ShowS
$cshow :: WorkflowAlreadyStarted -> String
show :: WorkflowAlreadyStarted -> String
$cshowList :: [WorkflowAlreadyStarted] -> ShowS
showList :: [WorkflowAlreadyStarted] -> ShowS
Show)


instance Exception WorkflowAlreadyStarted


data ChildWorkflowFailed = ChildWorkflowFailed Proto.Failure
  deriving stock (Int -> ChildWorkflowFailed -> ShowS
[ChildWorkflowFailed] -> ShowS
ChildWorkflowFailed -> String
(Int -> ChildWorkflowFailed -> ShowS)
-> (ChildWorkflowFailed -> String)
-> ([ChildWorkflowFailed] -> ShowS)
-> Show ChildWorkflowFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChildWorkflowFailed -> ShowS
showsPrec :: Int -> ChildWorkflowFailed -> ShowS
$cshow :: ChildWorkflowFailed -> String
show :: ChildWorkflowFailed -> String
$cshowList :: [ChildWorkflowFailed] -> ShowS
showList :: [ChildWorkflowFailed] -> ShowS
Show)


instance Exception ChildWorkflowFailed


data ChildWorkflowCancelled = ChildWorkflowCancelled
  deriving stock (Int -> ChildWorkflowCancelled -> ShowS
[ChildWorkflowCancelled] -> ShowS
ChildWorkflowCancelled -> String
(Int -> ChildWorkflowCancelled -> ShowS)
-> (ChildWorkflowCancelled -> String)
-> ([ChildWorkflowCancelled] -> ShowS)
-> Show ChildWorkflowCancelled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChildWorkflowCancelled -> ShowS
showsPrec :: Int -> ChildWorkflowCancelled -> ShowS
$cshow :: ChildWorkflowCancelled -> String
show :: ChildWorkflowCancelled -> String
$cshowList :: [ChildWorkflowCancelled] -> ShowS
showList :: [ChildWorkflowCancelled] -> ShowS
Show, ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool
(ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool)
-> (ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool)
-> Eq ChildWorkflowCancelled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool
== :: ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool
$c/= :: ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool
/= :: ChildWorkflowCancelled -> ChildWorkflowCancelled -> Bool
Eq)


-- { childWorkflowCancelledWorkflowId :: WorkflowId
-- , childWorkflowCancelledWorkflowType :: WorkflowType
-- , childWorkflowCancelledRunId :: Text
-- } deriving (Show)

instance Exception ChildWorkflowCancelled


data SignalExternalWorkflowFailed = SignalExternalWorkflowFailed Proto.Failure
  deriving stock (Int -> SignalExternalWorkflowFailed -> ShowS
[SignalExternalWorkflowFailed] -> ShowS
SignalExternalWorkflowFailed -> String
(Int -> SignalExternalWorkflowFailed -> ShowS)
-> (SignalExternalWorkflowFailed -> String)
-> ([SignalExternalWorkflowFailed] -> ShowS)
-> Show SignalExternalWorkflowFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignalExternalWorkflowFailed -> ShowS
showsPrec :: Int -> SignalExternalWorkflowFailed -> ShowS
$cshow :: SignalExternalWorkflowFailed -> String
show :: SignalExternalWorkflowFailed -> String
$cshowList :: [SignalExternalWorkflowFailed] -> ShowS
showList :: [SignalExternalWorkflowFailed] -> ShowS
Show)


instance Exception SignalExternalWorkflowFailed


-- This does not need to be in the exception hierarchy,
-- since we don't want to catch it in the workflow code.
data ContinueAsNewException = ContinueAsNewException
  { ContinueAsNewException -> WorkflowType
continueAsNewWorkflowType :: WorkflowType
  , ContinueAsNewException -> Vector Payload
continueAsNewArguments :: Vector Payload
  , ContinueAsNewException -> ContinueAsNewOptions
continueAsNewOptions :: ContinueAsNewOptions
  }
  deriving stock (Int -> ContinueAsNewException -> ShowS
[ContinueAsNewException] -> ShowS
ContinueAsNewException -> String
(Int -> ContinueAsNewException -> ShowS)
-> (ContinueAsNewException -> String)
-> ([ContinueAsNewException] -> ShowS)
-> Show ContinueAsNewException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ContinueAsNewException -> ShowS
showsPrec :: Int -> ContinueAsNewException -> ShowS
$cshow :: ContinueAsNewException -> String
show :: ContinueAsNewException -> String
$cshowList :: [ContinueAsNewException] -> ShowS
showList :: [ContinueAsNewException] -> ShowS
Show)


instance Exception ContinueAsNewException


data AlternativeInstanceFailure = AlternativeInstanceFailure
  deriving stock (Int -> AlternativeInstanceFailure -> ShowS
[AlternativeInstanceFailure] -> ShowS
AlternativeInstanceFailure -> String
(Int -> AlternativeInstanceFailure -> ShowS)
-> (AlternativeInstanceFailure -> String)
-> ([AlternativeInstanceFailure] -> ShowS)
-> Show AlternativeInstanceFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AlternativeInstanceFailure -> ShowS
showsPrec :: Int -> AlternativeInstanceFailure -> ShowS
$cshow :: AlternativeInstanceFailure -> String
show :: AlternativeInstanceFailure -> String
$cshowList :: [AlternativeInstanceFailure] -> ShowS
showList :: [AlternativeInstanceFailure] -> ShowS
Show)


instance Exception AlternativeInstanceFailure


data CancelExternalWorkflowFailed = CancelExternalWorkflowFailed Proto.Failure
  deriving stock (Int -> CancelExternalWorkflowFailed -> ShowS
[CancelExternalWorkflowFailed] -> ShowS
CancelExternalWorkflowFailed -> String
(Int -> CancelExternalWorkflowFailed -> ShowS)
-> (CancelExternalWorkflowFailed -> String)
-> ([CancelExternalWorkflowFailed] -> ShowS)
-> Show CancelExternalWorkflowFailed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CancelExternalWorkflowFailed -> ShowS
showsPrec :: Int -> CancelExternalWorkflowFailed -> ShowS
$cshow :: CancelExternalWorkflowFailed -> String
show :: CancelExternalWorkflowFailed -> String
$cshowList :: [CancelExternalWorkflowFailed] -> ShowS
showList :: [CancelExternalWorkflowFailed] -> ShowS
Show)


instance Exception CancelExternalWorkflowFailed


-- TODO, include the payload?
data WorkflowCancelRequested = WorkflowCancelRequested
  deriving stock (Int -> WorkflowCancelRequested -> ShowS
[WorkflowCancelRequested] -> ShowS
WorkflowCancelRequested -> String
(Int -> WorkflowCancelRequested -> ShowS)
-> (WorkflowCancelRequested -> String)
-> ([WorkflowCancelRequested] -> ShowS)
-> Show WorkflowCancelRequested
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowCancelRequested -> ShowS
showsPrec :: Int -> WorkflowCancelRequested -> ShowS
$cshow :: WorkflowCancelRequested -> String
show :: WorkflowCancelRequested -> String
$cshowList :: [WorkflowCancelRequested] -> ShowS
showList :: [WorkflowCancelRequested] -> ShowS
Show)


instance Exception WorkflowCancelRequested


data ActivityCancelled = ActivityCancelled Proto.Temporal.Api.Failure.V1.Message.Failure
  deriving stock (Int -> ActivityCancelled -> ShowS
[ActivityCancelled] -> ShowS
ActivityCancelled -> String
(Int -> ActivityCancelled -> ShowS)
-> (ActivityCancelled -> String)
-> ([ActivityCancelled] -> ShowS)
-> Show ActivityCancelled
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityCancelled -> ShowS
showsPrec :: Int -> ActivityCancelled -> ShowS
$cshow :: ActivityCancelled -> String
show :: ActivityCancelled -> String
$cshowList :: [ActivityCancelled] -> ShowS
showList :: [ActivityCancelled] -> ShowS
Show, ActivityCancelled -> ActivityCancelled -> Bool
(ActivityCancelled -> ActivityCancelled -> Bool)
-> (ActivityCancelled -> ActivityCancelled -> Bool)
-> Eq ActivityCancelled
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivityCancelled -> ActivityCancelled -> Bool
== :: ActivityCancelled -> ActivityCancelled -> Bool
$c/= :: ActivityCancelled -> ActivityCancelled -> Bool
/= :: ActivityCancelled -> ActivityCancelled -> Bool
Eq)


instance Exception ActivityCancelled


data ApplicationFailure = ApplicationFailure
  { ApplicationFailure -> Text
type' :: Text
  , ApplicationFailure -> Text
message :: Text
  , ApplicationFailure -> Bool
nonRetryable :: Bool
  , ApplicationFailure -> [Payload]
details :: [Payload]
  , ApplicationFailure -> Text
stack :: Text
  , ApplicationFailure -> Maybe Duration
nextRetryDelay :: Maybe Duration
  }
  deriving stock (Int -> ApplicationFailure -> ShowS
[ApplicationFailure] -> ShowS
ApplicationFailure -> String
(Int -> ApplicationFailure -> ShowS)
-> (ApplicationFailure -> String)
-> ([ApplicationFailure] -> ShowS)
-> Show ApplicationFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ApplicationFailure -> ShowS
showsPrec :: Int -> ApplicationFailure -> ShowS
$cshow :: ApplicationFailure -> String
show :: ApplicationFailure -> String
$cshowList :: [ApplicationFailure] -> ShowS
showList :: [ApplicationFailure] -> ShowS
Show, ApplicationFailure -> ApplicationFailure -> Bool
(ApplicationFailure -> ApplicationFailure -> Bool)
-> (ApplicationFailure -> ApplicationFailure -> Bool)
-> Eq ApplicationFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ApplicationFailure -> ApplicationFailure -> Bool
== :: ApplicationFailure -> ApplicationFailure -> Bool
$c/= :: ApplicationFailure -> ApplicationFailure -> Bool
/= :: ApplicationFailure -> ApplicationFailure -> Bool
Eq)


applicationFailureToFailureProto :: ApplicationFailure -> F.Failure
applicationFailureToFailureProto :: ApplicationFailure -> Failure
applicationFailureToFailureProto ApplicationFailure
appFailure =
  Failure
forall msg. Message msg => msg
defMessage
    Failure -> (Failure -> Failure) -> Failure
forall s t. s -> (s -> t) -> t
& LensLike' f Failure Text
forall {f :: * -> *}. Identical f => LensLike' f Failure Text
forall (f :: * -> *) s a.
(Functor f, HasField s "message" a) =>
LensLike' f s a
F.message (forall {f :: * -> *}. Identical f => LensLike' f Failure Text)
-> Text -> Failure -> Failure
forall s t a b. Setter s t a b -> b -> s -> t
.~ ApplicationFailure
appFailure.message
    Failure -> (Failure -> Failure) -> Failure
forall s t. s -> (s -> t) -> t
& LensLike' f Failure Text
forall {f :: * -> *}. Identical f => LensLike' f Failure Text
forall (f :: * -> *) s a.
(Functor f, HasField s "source" a) =>
LensLike' f s a
F.source (forall {f :: * -> *}. Identical f => LensLike' f Failure Text)
-> Text -> Failure -> Failure
forall s t a b. Setter s t a b -> b -> s -> t
.~ Text
"hs-temporal-sdk"
    Failure -> (Failure -> Failure) -> Failure
forall s t. s -> (s -> t) -> t
& LensLike' f Failure Text
forall {f :: * -> *}. Identical f => LensLike' f Failure Text
forall (f :: * -> *) s a.
(Functor f, HasField s "stackTrace" a) =>
LensLike' f s a
F.stackTrace (forall {f :: * -> *}. Identical f => LensLike' f Failure Text)
-> Text -> Failure -> Failure
forall s t a b. Setter s t a b -> b -> s -> t
.~ ApplicationFailure
appFailure.stack
    Failure -> (Failure -> Failure) -> Failure
forall s t. s -> (s -> t) -> t
& LensLike' f Failure ApplicationFailureInfo
forall {f :: * -> *}.
Identical f =>
LensLike' f Failure ApplicationFailureInfo
forall (f :: * -> *) s a.
(Functor f, HasField s "applicationFailureInfo" a) =>
LensLike' f s a
F.applicationFailureInfo
      (forall {f :: * -> *}.
 Identical f =>
 LensLike' f Failure ApplicationFailureInfo)
-> ApplicationFailureInfo -> Failure -> Failure
forall s t a b. Setter s t a b -> b -> s -> t
.~ ( ApplicationFailureInfo
forall msg. Message msg => msg
defMessage
            ApplicationFailureInfo
-> (ApplicationFailureInfo -> ApplicationFailureInfo)
-> ApplicationFailureInfo
forall s t. s -> (s -> t) -> t
& LensLike' f ApplicationFailureInfo Text
forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo Text
forall (f :: * -> *) s a.
(Functor f, HasField s "type'" a) =>
LensLike' f s a
F.type' (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ApplicationFailureInfo Text)
-> Text -> ApplicationFailureInfo -> ApplicationFailureInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ ApplicationFailure
appFailure.type'
            ApplicationFailureInfo
-> (ApplicationFailureInfo -> ApplicationFailureInfo)
-> ApplicationFailureInfo
forall s t. s -> (s -> t) -> t
& LensLike' f ApplicationFailureInfo Payloads
forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo Payloads
forall (f :: * -> *) s a.
(Functor f, HasField s "details" a) =>
LensLike' f s a
F.details (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ApplicationFailureInfo Payloads)
-> Payloads -> ApplicationFailureInfo -> ApplicationFailureInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (forall msg. Message msg => msg
defMessage @Common.Payloads Payloads -> (Payloads -> Payloads) -> Payloads
forall s t. s -> (s -> t) -> t
& LensLike' f Payloads [Payload]
forall {f :: * -> *}. Identical f => LensLike' f Payloads [Payload]
forall (f :: * -> *) s a.
(Functor f, HasField s "payloads" a) =>
LensLike' f s a
Common.payloads (forall {f :: * -> *}.
 Identical f =>
 LensLike' f Payloads [Payload])
-> [Payload] -> Payloads -> Payloads
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Payload -> Payload) -> [Payload] -> [Payload]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Payload -> Payload
convertToProtoPayload ApplicationFailure
appFailure.details)
            ApplicationFailureInfo
-> (ApplicationFailureInfo -> ApplicationFailureInfo)
-> ApplicationFailureInfo
forall s t. s -> (s -> t) -> t
& LensLike' f ApplicationFailureInfo Bool
forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo Bool
forall (f :: * -> *) s a.
(Functor f, HasField s "nonRetryable" a) =>
LensLike' f s a
F.nonRetryable (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ApplicationFailureInfo Bool)
-> Bool -> ApplicationFailureInfo -> ApplicationFailureInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ ApplicationFailure
appFailure.nonRetryable
            ApplicationFailureInfo
-> (ApplicationFailureInfo -> ApplicationFailureInfo)
-> ApplicationFailureInfo
forall s t. s -> (s -> t) -> t
& LensLike' f ApplicationFailureInfo (Maybe Duration)
forall {f :: * -> *}.
Identical f =>
LensLike' f ApplicationFailureInfo (Maybe Duration)
forall (f :: * -> *) s a.
(Functor f, HasField s "maybe'nextRetryDelay" a) =>
LensLike' f s a
F.maybe'nextRetryDelay (forall {f :: * -> *}.
 Identical f =>
 LensLike' f ApplicationFailureInfo (Maybe Duration))
-> Maybe Duration
-> ApplicationFailureInfo
-> ApplicationFailureInfo
forall s t a b. Setter s t a b -> b -> s -> t
.~ (Duration -> Duration) -> Maybe Duration -> Maybe Duration
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Duration -> Duration
durationToProto ApplicationFailure
appFailure.nextRetryDelay
         )


instance Exception ApplicationFailure


class ToApplicationFailure e where
  toApplicationFailure :: e -> ApplicationFailure


data SomeApplicationFailure = forall e. (Exception e, ToApplicationFailure e) => SomeApplicationFailure e


instance Show SomeApplicationFailure where
  show :: SomeApplicationFailure -> String
  show :: SomeApplicationFailure -> String
show (SomeApplicationFailure e
e) = e -> String
forall a. Show a => a -> String
show e
e


instance Exception SomeApplicationFailure


{- | A type of exception thrown to a running activity to cancel it due to things happening
with the worker, such as a shutdown. This differs from a normal activity cancellation, which
uses the 'cancel' function from the 'async' package.
-}
data ActivityCancelReason
  = -- | The activity no longer exists on the server (may already be completed or its workflow
    -- may be completed).
    NotFound
  | -- | The activity was explicitly cancelled.
    CancelRequested
  | -- | Activity timeout caused the activity to be marked cancelled.
    Timeout
  | -- | The worker the activity is running on is shutting down.
    WorkerShutdown
  | -- | We received a cancellation reason that we don't know how to handle.
    UnknownCancellationReason
  deriving stock (Int -> ActivityCancelReason -> ShowS
[ActivityCancelReason] -> ShowS
ActivityCancelReason -> String
(Int -> ActivityCancelReason -> ShowS)
-> (ActivityCancelReason -> String)
-> ([ActivityCancelReason] -> ShowS)
-> Show ActivityCancelReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityCancelReason -> ShowS
showsPrec :: Int -> ActivityCancelReason -> ShowS
$cshow :: ActivityCancelReason -> String
show :: ActivityCancelReason -> String
$cshowList :: [ActivityCancelReason] -> ShowS
showList :: [ActivityCancelReason] -> ShowS
Show)


instance Exception ActivityCancelReason where
  toException :: ActivityCancelReason -> SomeException
toException = ActivityCancelReason -> SomeException
forall e. Exception e => e -> SomeException
asyncExceptionToException
  fromException :: SomeException -> Maybe ActivityCancelReason
fromException = SomeException -> Maybe ActivityCancelReason
forall e. Exception e => SomeException -> Maybe e
asyncExceptionFromException


applicationFailureToException :: (Exception e, ToApplicationFailure e) => e -> SomeException
applicationFailureToException :: forall e.
(Exception e, ToApplicationFailure e) =>
e -> SomeException
applicationFailureToException e
e = SomeApplicationFailure -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeApplicationFailure -> SomeException)
-> SomeApplicationFailure -> SomeException
forall a b. (a -> b) -> a -> b
$ e -> SomeApplicationFailure
forall e.
(Exception e, ToApplicationFailure e) =>
e -> SomeApplicationFailure
SomeApplicationFailure e
e


applicationFailureFromException :: Exception e => SomeException -> Maybe e
applicationFailureFromException :: forall e. Exception e => SomeException -> Maybe e
applicationFailureFromException SomeException
e = do
  (SomeApplicationFailure e') <- SomeException -> Maybe SomeApplicationFailure
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e
  cast e'


data ApplicationFailureHandler where
  ApplicationFailureHandler :: Exception e => (e -> ApplicationFailure) -> ApplicationFailureHandler


-- Stripped down callstack rendering to work better in the Temporal UI.
prettySrcLoc :: SrcLoc -> String
prettySrcLoc :: SrcLoc -> String
prettySrcLoc SrcLoc {Int
String
srcLocPackage :: String
srcLocModule :: String
srcLocFile :: String
srcLocStartLine :: Int
srcLocStartCol :: Int
srcLocEndLine :: Int
srcLocEndCol :: Int
srcLocEndCol :: SrcLoc -> Int
srcLocEndLine :: SrcLoc -> Int
srcLocStartCol :: SrcLoc -> Int
srcLocStartLine :: SrcLoc -> Int
srcLocFile :: SrcLoc -> String
srcLocModule :: SrcLoc -> String
srcLocPackage :: SrcLoc -> String
..} =
  [String] -> String
forall a. Monoid a => [a] -> a
mconcat
    [ String
srcLocFile
    , String
":"
    , Int -> String
forall a. Show a => a -> String
show Int
srcLocStartLine
    , String
":"
    , Int -> String
forall a. Show a => a -> String
show Int
srcLocStartCol
    , String
" in "
    , String
srcLocPackage
    , String
":"
    , String
srcLocModule
    ]


{- | Pretty print a 'CallStack'.

@since 4.9.0.0
-}
prettyCallStack :: CallStack -> String
prettyCallStack :: CallStack -> String
prettyCallStack = [String] -> String
Prelude.unlines ([String] -> String)
-> (CallStack -> [String]) -> CallStack -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CallStack -> [String]
prettyCallStackLines


prettyCallStackLines :: CallStack -> [String]
prettyCallStackLines :: CallStack -> [String]
prettyCallStackLines CallStack
cs = case CallStack -> [(String, SrcLoc)]
getCallStack CallStack
cs of
  [] -> []
  [(String, SrcLoc)]
stk -> ((String, SrcLoc) -> String) -> [(String, SrcLoc)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map (String, SrcLoc) -> String
prettyCallSite [(String, SrcLoc)]
stk
  where
    prettyCallSite :: (String, SrcLoc) -> String
prettyCallSite (String
f, SrcLoc
loc) = String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", called at " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SrcLoc -> String
Temporal.Exception.prettySrcLoc SrcLoc
loc


mkApplicationFailure :: SomeException -> [ApplicationFailureHandler] -> ApplicationFailure
mkApplicationFailure :: SomeException -> [ApplicationFailureHandler] -> ApplicationFailure
mkApplicationFailure e :: SomeException
e@(SomeException e
e') = (ApplicationFailureHandler
 -> ApplicationFailure -> ApplicationFailure)
-> ApplicationFailure
-> [ApplicationFailureHandler]
-> ApplicationFailure
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Prelude.foldr ApplicationFailureHandler
-> ApplicationFailure -> ApplicationFailure
tryHandler (e -> ApplicationFailure
forall e. Exception e => e -> ApplicationFailure
basicHandler e
e')
  where
    tryHandler :: ApplicationFailureHandler
-> ApplicationFailure -> ApplicationFailure
tryHandler (ApplicationFailureHandler e -> ApplicationFailure
hndlr) ApplicationFailure
acc = ApplicationFailure
-> (e -> ApplicationFailure) -> Maybe e -> ApplicationFailure
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ApplicationFailure
acc e -> ApplicationFailure
hndlr (Maybe e -> ApplicationFailure) -> Maybe e -> ApplicationFailure
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe e
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e


annToPayload :: Annotation -> Payload
annToPayload :: Annotation -> Payload
annToPayload Annotation
ann = IO Payload -> Payload
forall a. IO a -> a
unsafePerformIO (IO Payload -> Payload) -> IO Payload -> Payload
forall a b. (a -> b) -> a -> b
$ JSON -> String -> IO Payload
forall fmt a. Codec fmt a => fmt -> a -> IO Payload
encode JSON
JSON (String -> IO Payload) -> String -> IO Payload
forall a b. (a -> b) -> a -> b
$ Annotation -> String
forall a. Show a => a -> String
show Annotation
ann


annotationHandler :: Exception e => (e -> ApplicationFailure) -> AnnotatedException e -> ApplicationFailure
annotationHandler :: forall e.
Exception e =>
(e -> ApplicationFailure)
-> AnnotatedException e -> ApplicationFailure
annotationHandler e -> ApplicationFailure
hndlr (AnnotatedException [Annotation]
anns e
e) =
  let
    -- wrapped = toException
    base :: ApplicationFailure
base = e -> ApplicationFailure
hndlr e
e
    ([CallStack]
stack', [Annotation]
annsWithoutStack) = [Annotation] -> ([CallStack], [Annotation])
forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations [Annotation]
anns
    ([NonRetryableError]
nonRetryable', [Annotation]
annsWithoutStackOrRetry) = [Annotation] -> ([NonRetryableError], [Annotation])
forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations [Annotation]
annsWithoutStack
    ([NextRetryDelay]
nextRetryDelay', [Annotation]
annsWithoutDelay) = [Annotation] -> ([NextRetryDelay], [Annotation])
forall a. Typeable a => [Annotation] -> ([a], [Annotation])
tryAnnotations [Annotation]
annsWithoutStackOrRetry
  in
    ApplicationFailure
base
      { stack =
          if base.stack == ""
            then case stack' of
              (CallStack
cs : [CallStack]
_) -> String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ CallStack -> String
Temporal.Exception.prettyCallStack CallStack
cs
              [CallStack]
_ -> ApplicationFailure
base.stack
            else base.stack
      , details = Prelude.map annToPayload annsWithoutDelay ++ base.details
      , nonRetryable = case nonRetryable' of
          (NonRetryableError Bool
b : [NonRetryableError]
_) -> Bool
b Bool -> Bool -> Bool
|| ApplicationFailure -> Bool
nonRetryable ApplicationFailure
base
          [NonRetryableError]
_ -> ApplicationFailure -> Bool
nonRetryable ApplicationFailure
base
      , nextRetryDelay = case nextRetryDelay' of
          (NextRetryDelay Maybe Duration
d : [NextRetryDelay]
_) -> Maybe Duration
d Maybe Duration -> Maybe Duration -> Maybe Duration
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ApplicationFailure -> Maybe Duration
nextRetryDelay ApplicationFailure
base
          [NextRetryDelay]
_ -> ApplicationFailure -> Maybe Duration
nextRetryDelay ApplicationFailure
base
      }


basicHandler :: Exception e => e -> ApplicationFailure
basicHandler :: forall e. Exception e => e -> ApplicationFailure
basicHandler e
e = case e -> SomeException
forall e. Exception e => e -> SomeException
toException e
e of
  (SomeException e
e') ->
    ApplicationFailure
      { type' :: Text
type' = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
e'
      , message :: Text
message = String -> Text
pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ e -> String
forall e. Exception e => e -> String
displayException e
e'
      , nonRetryable :: Bool
nonRetryable = Bool
False
      , details :: [Payload]
details = []
      , stack :: Text
stack = Text
""
      , nextRetryDelay :: Maybe Duration
nextRetryDelay = Maybe Duration
forall a. Maybe a
Nothing
      }


mkAnnotatedHandlers :: [ApplicationFailureHandler] -> [ApplicationFailureHandler]
mkAnnotatedHandlers :: [ApplicationFailureHandler] -> [ApplicationFailureHandler]
mkAnnotatedHandlers [ApplicationFailureHandler]
xs =
  ( [ApplicationFailureHandler]
xs [ApplicationFailureHandler]
-> (ApplicationFailureHandler -> [ApplicationFailureHandler])
-> [ApplicationFailureHandler]
forall a b. [a] -> (a -> [b]) -> [b]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ApplicationFailureHandler e -> ApplicationFailure
hndlr) ->
      [ (e -> ApplicationFailure) -> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler e -> ApplicationFailure
hndlr
      , (AnnotatedException e -> ApplicationFailure)
-> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler ((AnnotatedException e -> ApplicationFailure)
 -> ApplicationFailureHandler)
-> (AnnotatedException e -> ApplicationFailure)
-> ApplicationFailureHandler
forall a b. (a -> b) -> a -> b
$ \AnnotatedException e
e -> (e -> ApplicationFailure)
-> AnnotatedException e -> ApplicationFailure
forall e.
Exception e =>
(e -> ApplicationFailure)
-> AnnotatedException e -> ApplicationFailure
annotationHandler e -> ApplicationFailure
hndlr AnnotatedException e
e
      ]
  )
    [ApplicationFailureHandler]
-> [ApplicationFailureHandler] -> [ApplicationFailureHandler]
forall a. [a] -> [a] -> [a]
++ [(AnnotatedException SomeException -> ApplicationFailure)
-> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler ((AnnotatedException SomeException -> ApplicationFailure)
 -> ApplicationFailureHandler)
-> (AnnotatedException SomeException -> ApplicationFailure)
-> ApplicationFailureHandler
forall a b. (a -> b) -> a -> b
$ \AnnotatedException SomeException
e -> (SomeException -> ApplicationFailure)
-> AnnotatedException SomeException -> ApplicationFailure
forall e.
Exception e =>
(e -> ApplicationFailure)
-> AnnotatedException e -> ApplicationFailure
annotationHandler SomeException -> ApplicationFailure
forall e. Exception e => e -> ApplicationFailure
basicHandler (AnnotatedException SomeException
e :: AnnotatedException SomeException)]


standardApplicationFailureHandlers :: [ApplicationFailureHandler]
standardApplicationFailureHandlers :: [ApplicationFailureHandler]
standardApplicationFailureHandlers =
  [ (ApplicationFailure -> ApplicationFailure)
-> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler ((ApplicationFailure -> ApplicationFailure)
 -> ApplicationFailureHandler)
-> (ApplicationFailure -> ApplicationFailure)
-> ApplicationFailureHandler
forall a b. (a -> b) -> a -> b
$ \h :: ApplicationFailure
h@ApplicationFailure {} -> ApplicationFailure
h
  , (SomeApplicationFailure -> ApplicationFailure)
-> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler ((SomeApplicationFailure -> ApplicationFailure)
 -> ApplicationFailureHandler)
-> (SomeApplicationFailure -> ApplicationFailure)
-> ApplicationFailureHandler
forall a b. (a -> b) -> a -> b
$ \(SomeApplicationFailure e
e) -> e -> ApplicationFailure
forall e. ToApplicationFailure e => e -> ApplicationFailure
toApplicationFailure e
e
  , (ErrorCall -> ApplicationFailure) -> ApplicationFailureHandler
forall e.
Exception e =>
(e -> ApplicationFailure) -> ApplicationFailureHandler
ApplicationFailureHandler ((ErrorCall -> ApplicationFailure) -> ApplicationFailureHandler)
-> (ErrorCall -> ApplicationFailure) -> ApplicationFailureHandler
forall a b. (a -> b) -> a -> b
$ \(ErrorCallWithLocation String
msg String
loc) ->
      ApplicationFailure
        { type' :: Text
type' = Text
"ErrorCallWithLocation"
        , message :: Text
message = String -> Text
pack String
msg
        , nonRetryable :: Bool
nonRetryable = Bool
False
        , details :: [Payload]
details = []
        , stack :: Text
stack = String -> Text
pack String
loc
        , nextRetryDelay :: Maybe Duration
nextRetryDelay = Maybe Duration
forall a. Maybe a
Nothing
        }
  ]


data ActivityFailure = ActivityFailure
  { ActivityFailure -> Text
message :: Text
  , ActivityFailure -> ActivityType
activityType :: ActivityType
  , ActivityFailure -> ActivityId
activityId :: ActivityId
  , ActivityFailure -> RetryState
retryState :: RetryState
  , ActivityFailure -> Text
identity :: Text
  , ActivityFailure -> ApplicationFailure
cause :: ApplicationFailure
  , ActivityFailure -> Int64
scheduledEventId :: Int64
  , ActivityFailure -> Int64
startedEventId :: Int64
  , ActivityFailure -> ActivityFailureInfo
original :: ActivityFailureInfo
  , ActivityFailure -> Text
stack :: Text
  }
  deriving stock (Int -> ActivityFailure -> ShowS
[ActivityFailure] -> ShowS
ActivityFailure -> String
(Int -> ActivityFailure -> ShowS)
-> (ActivityFailure -> String)
-> ([ActivityFailure] -> ShowS)
-> Show ActivityFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ActivityFailure -> ShowS
showsPrec :: Int -> ActivityFailure -> ShowS
$cshow :: ActivityFailure -> String
show :: ActivityFailure -> String
$cshowList :: [ActivityFailure] -> ShowS
showList :: [ActivityFailure] -> ShowS
Show, ActivityFailure -> ActivityFailure -> Bool
(ActivityFailure -> ActivityFailure -> Bool)
-> (ActivityFailure -> ActivityFailure -> Bool)
-> Eq ActivityFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ActivityFailure -> ActivityFailure -> Bool
== :: ActivityFailure -> ActivityFailure -> Bool
$c/= :: ActivityFailure -> ActivityFailure -> Bool
/= :: ActivityFailure -> ActivityFailure -> Bool
Eq)


instance Exception ActivityFailure


data NonRetryableError = NonRetryableError Bool
  deriving stock (Int -> NonRetryableError -> ShowS
[NonRetryableError] -> ShowS
NonRetryableError -> String
(Int -> NonRetryableError -> ShowS)
-> (NonRetryableError -> String)
-> ([NonRetryableError] -> ShowS)
-> Show NonRetryableError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NonRetryableError -> ShowS
showsPrec :: Int -> NonRetryableError -> ShowS
$cshow :: NonRetryableError -> String
show :: NonRetryableError -> String
$cshowList :: [NonRetryableError] -> ShowS
showList :: [NonRetryableError] -> ShowS
Show, NonRetryableError -> NonRetryableError -> Bool
(NonRetryableError -> NonRetryableError -> Bool)
-> (NonRetryableError -> NonRetryableError -> Bool)
-> Eq NonRetryableError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NonRetryableError -> NonRetryableError -> Bool
== :: NonRetryableError -> NonRetryableError -> Bool
$c/= :: NonRetryableError -> NonRetryableError -> Bool
/= :: NonRetryableError -> NonRetryableError -> Bool
Eq)


annotateNonRetryableError :: Annotation
annotateNonRetryableError :: Annotation
annotateNonRetryableError = NonRetryableError -> Annotation
forall a. AnnC a => a -> Annotation
Annotation (NonRetryableError -> Annotation)
-> NonRetryableError -> Annotation
forall a b. (a -> b) -> a -> b
$ Bool -> NonRetryableError
NonRetryableError Bool
True


annotateRetryableError :: Annotation
annotateRetryableError :: Annotation
annotateRetryableError = NonRetryableError -> Annotation
forall a. AnnC a => a -> Annotation
Annotation (NonRetryableError -> Annotation)
-> NonRetryableError -> Annotation
forall a b. (a -> b) -> a -> b
$ Bool -> NonRetryableError
NonRetryableError Bool
False


data NextRetryDelay = NextRetryDelay (Maybe Duration)
  deriving stock (Int -> NextRetryDelay -> ShowS
[NextRetryDelay] -> ShowS
NextRetryDelay -> String
(Int -> NextRetryDelay -> ShowS)
-> (NextRetryDelay -> String)
-> ([NextRetryDelay] -> ShowS)
-> Show NextRetryDelay
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NextRetryDelay -> ShowS
showsPrec :: Int -> NextRetryDelay -> ShowS
$cshow :: NextRetryDelay -> String
show :: NextRetryDelay -> String
$cshowList :: [NextRetryDelay] -> ShowS
showList :: [NextRetryDelay] -> ShowS
Show, NextRetryDelay -> NextRetryDelay -> Bool
(NextRetryDelay -> NextRetryDelay -> Bool)
-> (NextRetryDelay -> NextRetryDelay -> Bool) -> Eq NextRetryDelay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NextRetryDelay -> NextRetryDelay -> Bool
== :: NextRetryDelay -> NextRetryDelay -> Bool
$c/= :: NextRetryDelay -> NextRetryDelay -> Bool
/= :: NextRetryDelay -> NextRetryDelay -> Bool
Eq)


annotateNextRetryDelay :: Duration -> Annotation
annotateNextRetryDelay :: Duration -> Annotation
annotateNextRetryDelay = NextRetryDelay -> Annotation
forall a. AnnC a => a -> Annotation
Annotation (NextRetryDelay -> Annotation)
-> (Duration -> NextRetryDelay) -> Duration -> Annotation
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Duration -> NextRetryDelay
NextRetryDelay (Maybe Duration -> NextRetryDelay)
-> (Duration -> Maybe Duration) -> Duration -> NextRetryDelay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Duration -> Maybe Duration
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure


annotateNoRetryDelay :: Annotation
annotateNoRetryDelay :: Annotation
annotateNoRetryDelay = NextRetryDelay -> Annotation
forall a. AnnC a => a -> Annotation
Annotation (NextRetryDelay -> Annotation) -> NextRetryDelay -> Annotation
forall a b. (a -> b) -> a -> b
$ Maybe Duration -> NextRetryDelay
NextRetryDelay Maybe Duration
forall a. Maybe a
Nothing


---------------------------------------------------------------------
-- Activity exceptions

data SomeActivityException = forall e. Exception e => SomeActivityException e


instance Show SomeActivityException where
  show :: SomeActivityException -> String
show (SomeActivityException e
e) = e -> String
forall a. Show a => a -> String
show e
e


instance Exception SomeActivityException


activityExceptionToException :: Exception e => e -> SomeException
activityExceptionToException :: forall e. Exception e => e -> SomeException
activityExceptionToException = SomeActivityException -> SomeException
forall e. Exception e => e -> SomeException
toException (SomeActivityException -> SomeException)
-> (e -> SomeActivityException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> SomeActivityException
forall e. Exception e => e -> SomeActivityException
SomeActivityException


activityExceptionFromException :: Exception e => SomeException -> Maybe e
activityExceptionFromException :: forall e. Exception e => SomeException -> Maybe e
activityExceptionFromException SomeException
x = do
  SomeActivityException a <- SomeException -> Maybe SomeActivityException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
  cast a


{- |
Asynchronous Activity Completion is a feature that enables an Activity Function to return without causing the Activity Execution to complete. The Temporal Client can then be used to both Heartbeat Activity Execution progress and eventually provide a result.

The intended use-case for this feature is when an external system has the final result of a computation, started by an Activity.

Consider using Asynchronous Activities instead of Signals if the external process is unreliable and might fail to send critical status updates through a Signal.

Consider using Signals as an alternative to Asynchronous Activities to return data back to a Workflow Execution if there is a human in the process loop. The reason is that a human in the loop means multiple steps in the process. The first is the Activity Function that stores state in an external system and at least one other step where a human would “complete” the activity. If the first step fails, you want to detect that quickly and retry instead of waiting for the entire process, which could be significantly longer when humans are involved.
-}
data CompleteAsync = CompleteAsync
  deriving stock (Int -> CompleteAsync -> ShowS
[CompleteAsync] -> ShowS
CompleteAsync -> String
(Int -> CompleteAsync -> ShowS)
-> (CompleteAsync -> String)
-> ([CompleteAsync] -> ShowS)
-> Show CompleteAsync
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CompleteAsync -> ShowS
showsPrec :: Int -> CompleteAsync -> ShowS
$cshow :: CompleteAsync -> String
show :: CompleteAsync -> String
$cshowList :: [CompleteAsync] -> ShowS
showList :: [CompleteAsync] -> ShowS
Show)


instance Exception CompleteAsync where
  toException :: CompleteAsync -> SomeException
toException = CompleteAsync -> SomeException
forall e. Exception e => e -> SomeException
activityExceptionToException
  fromException :: SomeException -> Maybe CompleteAsync
fromException = SomeException -> Maybe CompleteAsync
forall e. Exception e => SomeException -> Maybe e
activityExceptionFromException


data WorkflowExecutionClosed
  = WorkflowExecutionFailed WorkflowExecutionFailedEventAttributes
  | WorkflowExecutionTimedOut
  | WorkflowExecutionCanceled
  | WorkflowExecutionTerminated
  | WorkflowExecutionContinuedAsNew
  deriving stock (Int -> WorkflowExecutionClosed -> ShowS
[WorkflowExecutionClosed] -> ShowS
WorkflowExecutionClosed -> String
(Int -> WorkflowExecutionClosed -> ShowS)
-> (WorkflowExecutionClosed -> String)
-> ([WorkflowExecutionClosed] -> ShowS)
-> Show WorkflowExecutionClosed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowExecutionClosed -> ShowS
showsPrec :: Int -> WorkflowExecutionClosed -> ShowS
$cshow :: WorkflowExecutionClosed -> String
show :: WorkflowExecutionClosed -> String
$cshowList :: [WorkflowExecutionClosed] -> ShowS
showList :: [WorkflowExecutionClosed] -> ShowS
Show, WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool
(WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool)
-> (WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool)
-> Eq WorkflowExecutionClosed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool
== :: WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool
$c/= :: WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool
/= :: WorkflowExecutionClosed -> WorkflowExecutionClosed -> Bool
Eq)


instance Exception WorkflowExecutionClosed


data WorkflowExecutionFailedAttributes = WorkflowExecutionFailedAttributes
  { WorkflowExecutionFailedAttributes -> Maybe Failure
failure :: Maybe Failure
  , WorkflowExecutionFailedAttributes -> RetryState
retryState :: RetryState
  , WorkflowExecutionFailedAttributes -> Int64
workflowTaskCompletedEventId :: Int64
  , WorkflowExecutionFailedAttributes -> Maybe RunId
newExecutionRunId :: Maybe RunId
  }
  deriving stock (Int -> WorkflowExecutionFailedAttributes -> ShowS
[WorkflowExecutionFailedAttributes] -> ShowS
WorkflowExecutionFailedAttributes -> String
(Int -> WorkflowExecutionFailedAttributes -> ShowS)
-> (WorkflowExecutionFailedAttributes -> String)
-> ([WorkflowExecutionFailedAttributes] -> ShowS)
-> Show WorkflowExecutionFailedAttributes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkflowExecutionFailedAttributes -> ShowS
showsPrec :: Int -> WorkflowExecutionFailedAttributes -> ShowS
$cshow :: WorkflowExecutionFailedAttributes -> String
show :: WorkflowExecutionFailedAttributes -> String
$cshowList :: [WorkflowExecutionFailedAttributes] -> ShowS
showList :: [WorkflowExecutionFailedAttributes] -> ShowS
Show, WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool
(WorkflowExecutionFailedAttributes
 -> WorkflowExecutionFailedAttributes -> Bool)
-> (WorkflowExecutionFailedAttributes
    -> WorkflowExecutionFailedAttributes -> Bool)
-> Eq WorkflowExecutionFailedAttributes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool
== :: WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool
$c/= :: WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool
/= :: WorkflowExecutionFailedAttributes
-> WorkflowExecutionFailedAttributes -> Bool
Eq)