Make object recovery settlement-safe

src/Nuthatch/Protocol.hs

@@ -354,19 +354,34 @@ markApplying conn rec = do
     (unUserId (mrUserId rec), kindLabel (mrKind rec), unOperationId (mrOperationId rec))
   pure (n == 1)
 
-markExternalPending :: Connection -> MutationRecord -> IO Bool
-markExternalPending conn rec = do
+markExternalPending
+  :: Connection
+  -> MutationRecord
+  -> Integer
+  -> Integer
+  -> IO Bool
+markExternalPending conn rec settlementBoundSec workerGraceSec = do
   n <- execute conn
-    "UPDATE mutations SET external_state = 'pending', updated_at = now() \
+    "UPDATE mutations SET external_state = 'pending', \
+    \dispatch_started_at = now(), \
+    \request_deadline_at = now() + (? * interval '1 second'), \
+    \worker_lease_until = now() + (? * interval '1 second'), \
+    \updated_at = now() \
     \WHERE user_id = ? AND kind = ? AND operation_id = ? \
     \AND state = 'applying' AND external_state = 'idle'"
-    (unUserId (mrUserId rec), kindLabel (mrKind rec), unOperationId (mrOperationId rec))
+    ( settlementBoundSec
+    , workerGraceSec
+    , unUserId (mrUserId rec)
+    , kindLabel (mrKind rec)
+    , unOperationId (mrOperationId rec)
+    )
   pure (n == 1)
 
 markExternalSettled :: Connection -> MutationRecord -> IO Bool
 markExternalSettled conn rec = do
   n <- execute conn
-    "UPDATE mutations SET external_state = 'settled', updated_at = now() \
+    "UPDATE mutations SET external_state = 'settled', settled_at = now(), \
+    \updated_at = now() \
     \WHERE user_id = ? AND kind = ? AND operation_id = ? \
     \AND state = 'applying' AND external_state = 'pending'"
     (unUserId (mrUserId rec), kindLabel (mrKind rec), unOperationId (mrOperationId rec))
@@ -375,7 +390,8 @@ markExternalSettled conn rec = do
 markSettledFromIdle :: Connection -> MutationRecord -> IO Bool
 markSettledFromIdle conn rec = do
   n <- execute conn
-    "UPDATE mutations SET external_state = 'settled', updated_at = now() \
+    "UPDATE mutations SET external_state = 'settled', settled_at = now(), \
+    \updated_at = now() \
     \WHERE user_id = ? AND kind = ? AND operation_id = ? \
     \AND state = 'applying' AND external_state = 'idle'"
     (unUserId (mrUserId rec), kindLabel (mrKind rec), unOperationId (mrOperationId rec))
@@ -462,11 +478,19 @@ claimActiveBatch conn limit graceSec = do
     \declared_size, content_sha256, prior_size, prior_sha256, growth_bytes, \
     \state, external_state FROM mutations \
     \WHERE state IN ('prepared', 'applying') \
-    \AND updated_at < now() - (? * interval '1 second') \
+    \AND ( \
+    \  (external_state = 'idle' \
+    \    AND updated_at < now() - (? * interval '1 second')) \
+    \  OR (external_state = 'settled' \
+    \    AND updated_at < now() - (? * interval '1 second')) \
+    \  OR (external_state = 'pending' \
+    \    AND worker_lease_until < now() \
+    \    AND request_deadline_at < now()) \
+    \) \
     \ORDER BY updated_at ASC \
     \FOR UPDATE SKIP LOCKED \
     \LIMIT ?"
-    (graceSec, limit)
+    (graceSec, graceSec, limit)
   pure (mapMaybe rowToRecord rows)
 
 desiredMatches :: MutationRecord -> ObjectObservation -> Bool