/
Trigger.daml
67 lines (56 loc) · 2.38 KB
/
Trigger.daml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
module Trigger where
import DA.Action
import qualified Daml.Trigger as T
import Daml.Trigger.LowLevel
import DA.Foldable (forA_)
import Main
data FailureState = FailureState {
allowedFailures : Int
, currentFailures : Int
, failureMessages : [Text]
} deriving (Show, Eq)
exampleTrigger : T.Trigger FailureState
exampleTrigger = T.Trigger
{ initialize = pure $ initFailureState 10
, updateState = updateStateFailures
, rule = exampleRule
, registeredTemplates = T.AllInDar
, heartbeat = None
}
-- The rule for our example trigger
exampleRule : Party -> T.TriggerA FailureState ()
exampleRule party = withFailures party $ do
assets <- T.query @AssertOrArchive
forA_ assets (\(cid,_) -> T.dedupExercise cid Go)
-- Create initial 'FailureState' with specified allowed failures
initFailureState : Int -> FailureState
initFailureState allowedFailures = FailureState allowedFailures 0 []
addFailure : Text -> FailureState -> FailureState
addFailure m fs = fs with
currentFailures = fs.currentFailures + 1
failureMessages = m :: fs.failureMessages
-- Use as or in the triggers' 'updateState' function, watches for failed commands and
-- update 'FailureState' accordingly.
updateStateFailures : Message -> T.TriggerUpdateA FailureState ()
updateStateFailures m = case m of
(MCompletion (Completion _ (Failed _ msg))) -> modify $ addFailure msg
_ -> pure ()
-- Wrapper function that handles stopping a trigger when 'allowedFailures' is exceeded, creating the
-- notification, and starting the trigger back up when requested.
withFailures : Party -> T.TriggerA FailureState () -> T.TriggerA FailureState ()
withFailures party triggerFn = do
ts <- get
if ts.currentFailures < ts.allowedFailures
then triggerFn
else do
failureNotifications <- T.query @TriggerFailureNotification
-- Create a Trigger Failure notification if we haven't already
when (null failureNotifications) $ do
debug $ "Trigger has exceeded maximum failures!"
T.dedupCreate $ TriggerFailureNotification with failureMessages = ts.failureMessages, party = party
-- Look for restart requests, if there are any, acknowledge them and start up the trigger again
restartRequests <- T.query @FailedTriggerStartRequest
forA_ restartRequests (\(cid,_) -> do
T.dedupExercise cid Acknowledge
put $ FailureState ts.allowedFailures 0 []
)