module Control.Concurrent.Capataz.Internal.Types where
import Protolude
import Control.Concurrent.STM.TVar (TVar)
import Control.Teardown (ITeardown (..), Teardown)
import Data.Default (Default (..))
import Data.HashMap.Strict (HashMap)
import Data.IORef (IORef)
import Data.Time.Clock (NominalDiffTime, UTCTime)
import Data.UUID (UUID)
type CapatazId = UUID
type WorkerId = UUID
type SupervisorId = UUID
type ProcessId = UUID
type WorkerAction = IO ()
type ProcessThreadId = ThreadId
type ProcessName = Text
type CapatazName = Text
type SupervisorName = Text
type WorkerName = Text
type RestartCount = Int
type ProcessMap = HashMap ProcessId Process
type ParentSupervisor = Supervisor
data CapatazEvent
= InvalidSupervisorStatusReached {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, eventTime :: !UTCTime
}
| SupervisorStatusChanged {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, prevSupervisorStatus :: !SupervisorStatus
, newSupervisorStatus :: !SupervisorStatus
, eventTime :: !UTCTime
}
| ProcessTerminated {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, processThreadId :: !ProcessThreadId
, processId :: !ProcessId
, processName :: !ProcessName
, processType :: !ProcessType
, terminationReason :: !Text
, eventTime :: !UTCTime
}
| ProcessStarted {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, processThreadId :: !ProcessThreadId
, processId :: !ProcessId
, processName :: !ProcessName
, processType :: !ProcessType
, eventTime :: !UTCTime
}
| ProcessRestarted {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, processThreadId :: !ProcessThreadId
, processId :: !ProcessId
, processName :: !ProcessName
, processType :: !ProcessType
, processRestartCount :: !Int
, eventTime :: !UTCTime
}
| ProcessCompleted {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, processThreadId :: !ProcessThreadId
, processId :: !ProcessId
, processName :: !ProcessName
, processType :: !ProcessType
, eventTime :: !UTCTime
}
| ProcessFailed {
supervisorName :: !SupervisorName
, supervisorId :: !SupervisorId
, processThreadId :: !ProcessThreadId
, processId :: !ProcessId
, processName :: !ProcessName
, processType :: !ProcessType
, processError :: !SomeException
, eventTime :: !UTCTime
}
| ProcessCallbackExecuted {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, processThreadId :: !ProcessThreadId
, processId :: !ProcessId
, processName :: !ProcessName
, processType :: !ProcessType
, processCallbackError :: !(Maybe SomeException)
, processCallbackType :: !CallbackType
, eventTime :: !UTCTime
}
| ProcessTerminationStarted {
supervisorName :: !SupervisorName
, supervisorId :: !SupervisorId
, terminationReason :: !Text
, eventTime :: !UTCTime
}
| ProcessTerminationFinished {
supervisorName :: !SupervisorName
, supervisorId :: !SupervisorId
, terminationReason :: !Text
, eventTime :: !UTCTime
}
| CapatazFailed {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, supervisorError :: !SomeException
, eventTime :: !UTCTime
}
| CapatazTerminated {
supervisorName :: !SupervisorName
, supervisorId :: !SupervisorId
, eventTime :: !UTCTime
}
deriving (Generic, Show)
data WorkerTerminationPolicy
= Infinity
| BrutalTermination
| TimeoutMillis !Int
deriving (Generic, Show, Eq, Ord)
instance Default WorkerTerminationPolicy where
def = TimeoutMillis 3000
instance NFData WorkerTerminationPolicy
data ProcessRestartAction
= ResetRestartCount
| IncreaseRestartCount
| HaltSupervisor
deriving (Generic, Show, Eq)
instance NFData ProcessRestartAction
data ProcessTerminationOrder
= NewestFirst
| OldestFirst
deriving (Generic, Show, Eq, Ord)
instance Default ProcessTerminationOrder where
def = OldestFirst
instance NFData ProcessTerminationOrder
data SupervisorRestartStrategy
= AllForOne
| OneForOne
deriving (Generic, Show, Eq, Ord)
instance Default SupervisorRestartStrategy where
def = OneForOne
instance NFData SupervisorRestartStrategy
data CapatazOptions
= CapatazOptions {
supervisorName :: !SupervisorName
, supervisorIntensity :: !Int
, supervisorPeriodSeconds :: !NominalDiffTime
, supervisorRestartStrategy :: !SupervisorRestartStrategy
, supervisorProcessSpecList :: ![ProcessSpec]
, supervisorProcessTerminationOrder :: !ProcessTerminationOrder
, supervisorOnIntensityReached :: !(IO ())
, supervisorOnFailure :: !(SomeException -> IO ())
, notifyEvent :: !(CapatazEvent -> IO ())
}
data WorkerRestartStrategy
= Permanent
| Transient
| Temporary
deriving (Generic, Show, Eq)
instance NFData WorkerRestartStrategy
instance Default WorkerRestartStrategy where
def = Transient
data WorkerOptions
= WorkerOptions {
workerAction :: WorkerAction
, workerName :: !WorkerName
, workerOnFailure :: !(SomeException -> IO ())
, workerOnCompletion :: !(IO ())
, workerOnTermination :: !(IO ())
, workerTerminationPolicy :: !WorkerTerminationPolicy
, workerRestartStrategy :: !WorkerRestartStrategy
}
deriving (Generic)
data Worker
= Worker {
workerId :: !WorkerId
, workerAsync :: !(Async ())
, workerCreationTime :: !UTCTime
, workerName :: !WorkerName
, workerOptions :: !WorkerOptions
}
data ProcessEnv
= ProcessEnv {
processId :: !ProcessId
, processName :: !ProcessName
, processAsync :: !(Async ())
, processCreationTime :: !UTCTime
, processRestartStrategy :: !WorkerRestartStrategy
}
data SupervisorOptions
= SupervisorOptions {
supervisorName :: Text
, supervisorIntensity :: !Int
, supervisorPeriodSeconds :: !NominalDiffTime
, supervisorRestartStrategy :: !SupervisorRestartStrategy
, supervisorProcessSpecList :: ![ProcessSpec]
, supervisorProcessTerminationOrder :: !ProcessTerminationOrder
, supervisorOnIntensityReached :: !(IO ())
, supervisorOnFailure :: !(SomeException -> IO ())
}
data Supervisor
= Supervisor {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, supervisorOptions :: !SupervisorOptions
, supervisorCreationTime :: !UTCTime
, supervisorAsync :: !(Async ())
, supervisorNotify :: SupervisorMessage -> IO ()
, supervisorEnv :: !SupervisorEnv
}
data ControlAction
= ForkWorker {
workerOptions :: !WorkerOptions
, returnWorkerId :: !(WorkerId -> IO ())
}
| ForkSupervisor {
supervisorOptions :: !SupervisorOptions
, returnSupervisor :: !(Supervisor -> IO ())
}
| TerminateProcess {
processId :: !ProcessId
, processTerminationReason :: !Text
, notifyProcessTermination :: !(Bool -> IO ())
}
deriving (Generic)
data CapatazSignal
= CapatazFailure
| RestartProcessException
| TerminateProcessException {
processId :: !ProcessId
, processTerminationReason :: !Text
}
| BrutallyTerminateProcessException {
processId :: !ProcessId
, processTerminationReason :: !Text
}
deriving (Generic, Show)
instance Exception CapatazSignal
instance NFData CapatazSignal
data CapatazError
= SupervisorIntensityReached {
processId :: !ProcessId
, processName :: !ProcessName
, processRestartCount :: !Int
}
deriving (Generic, Show)
instance Exception CapatazError
instance NFData CapatazError
data CallbackType
= OnCompletion
| OnFailure
| OnTermination
deriving (Generic, Show, Eq)
data ProcessType
= SupervisorType
| WorkerType
deriving (Show, Eq)
data ProcessError
= ProcessCallbackFailed {
processId :: !WorkerId
, processError :: !(Maybe SomeException)
, processCallbackError :: !SomeException
, processCallbackType :: !CallbackType
}
deriving (Generic, Show)
instance Exception ProcessError
data MonitorEvent
= ProcessTerminated' {
processId :: !ProcessId
, processName :: !ProcessName
, processRestartCount :: !RestartCount
, processTerminationReason :: !Text
, monitorEventTime :: !UTCTime
}
| ProcessFailed' {
processId :: !WorkerId
, processName :: !WorkerName
, processRestartCount :: !RestartCount
, processError :: !SomeException
, monitorEventTime :: !UTCTime
}
| ProcessCompleted' {
processId :: !ProcessId
, processName :: !ProcessName
, monitorEventTime :: !UTCTime
}
| ProcessForcedRestart {
processId :: !ProcessId
, processName :: !ProcessName
, monitorEventTime :: !UTCTime
}
deriving (Show)
data SupervisorStatus
= Initializing
| Running
| Halting
| Halted
deriving (Generic, Show, Eq)
instance NFData SupervisorStatus
data SupervisorMessage
= ControlAction !ControlAction
| MonitorEvent !MonitorEvent
deriving (Generic)
data Process
= WorkerProcess Worker
| SupervisorProcess Supervisor
data ProcessSpec
= WorkerSpec WorkerOptions
| SupervisorSpec SupervisorOptions
data Capataz
= Capataz {
capatazSupervisor :: !Supervisor
, capatazTeardown :: !Teardown
}
instance ITeardown Capataz where
teardown Capataz {capatazTeardown} =
teardown capatazTeardown
data ParentSupervisorEnv
= ParentSupervisorEnv {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, supervisorNotify :: !(SupervisorMessage -> IO ())
, notifyEvent :: !(CapatazEvent -> IO ())
}
data SupervisorEnv
= SupervisorEnv {
supervisorId :: !SupervisorId
, supervisorName :: !SupervisorName
, supervisorNotify :: !(SupervisorMessage -> IO ())
, supervisorGetNotification :: !(STM SupervisorMessage)
, supervisorProcessMap :: !(IORef ProcessMap)
, supervisorStatusVar :: !(TVar SupervisorStatus)
, supervisorOptions :: !SupervisorOptions
, supervisorIntensity :: !Int
, supervisorPeriodSeconds :: !NominalDiffTime
, supervisorRestartStrategy :: !SupervisorRestartStrategy
, supervisorProcessTerminationOrder :: !ProcessTerminationOrder
, supervisorOnIntensityReached :: !(IO ())
, supervisorOnIntensityReached :: !(SomeException -> IO ())
, notifyEvent :: !(CapatazEvent -> IO ())
}
defCapatazOptions
:: Text
-> (CapatazOptions -> CapatazOptions)
-> CapatazOptions
defCapatazOptions supervisorName modFn = modFn CapatazOptions
{ supervisorName
, supervisorIntensity = 2
, supervisorPeriodSeconds = 5
, supervisorRestartStrategy = def
, supervisorProcessSpecList = []
, supervisorProcessTerminationOrder = OldestFirst
, supervisorOnIntensityReached = return ()
, supervisorOnFailure = const $ return ()
, notifyEvent = const $ return ()
}
supervisorSpec
:: SupervisorName
-> (SupervisorOptions -> SupervisorOptions)
-> ProcessSpec
supervisorSpec sName modFn =
SupervisorSpec (buildSupervisorOptions sName modFn)
supervisorSpecWithDefaults
:: SupervisorName
-> ProcessSpec
supervisorSpecWithDefaults sName = supervisorSpec sName identity
workerSpec
:: WorkerName
-> IO ()
-> (WorkerOptions -> WorkerOptions)
-> ProcessSpec
workerSpec wName wAction modFn =
WorkerSpec (buildWorkerOptions wName wAction modFn)
workerSpecWithDefaults
:: WorkerName
-> IO ()
-> ProcessSpec
workerSpecWithDefaults wName wAction = workerSpec wName wAction identity
buildSupervisorOptions
:: SupervisorName
-> (SupervisorOptions -> SupervisorOptions)
-> SupervisorOptions
buildSupervisorOptions supervisorName modFn = modFn SupervisorOptions
{ supervisorName
, supervisorIntensity = 2
, supervisorPeriodSeconds = 5
, supervisorRestartStrategy = def
, supervisorProcessSpecList = []
, supervisorProcessTerminationOrder = OldestFirst
, supervisorOnIntensityReached = return ()
, supervisorOnFailure = const $ return ()
}
buildSupervisorOptionsWithDefaults
:: SupervisorName
-> SupervisorOptions
buildSupervisorOptionsWithDefaults = flip buildSupervisorOptions identity
buildWorkerOptions
:: WorkerName
-> IO ()
-> (WorkerOptions -> WorkerOptions)
-> WorkerOptions
buildWorkerOptions workerName workerAction f = f WorkerOptions
{ workerName
, workerAction
, workerOnFailure = const $ return ()
, workerOnCompletion = return ()
, workerOnTermination = return ()
, workerTerminationPolicy = def
, workerRestartStrategy = def
}
buildWorkerOptionsWithDefaults
:: WorkerName
-> IO ()
-> WorkerOptions
buildWorkerOptionsWithDefaults wName wAction =
buildWorkerOptions wName wAction identity