Add bounded protocol and target conformance gate

src/Nuthatch/Protocol.hs

@@ -13,6 +13,7 @@ module Nuthatch.Protocol
   , finalizeFailure
   , claimActiveBatch
   , lookupMutation
+  , mutationEpochExists
   , lookupObjectMeta
   , sameFingerprint
   , existingDisposition
@@ -104,6 +105,29 @@ lookupMutation conn uid kind op = do
     (unUserId uid, kindLabel kind, unOperationId op)
   pure (listToMaybe rows >>= rowToRecord)
 
+mutationEpochExists
+  :: Connection
+  -> UserId
+  -> MutationKind
+  -> OperationId
+  -> Integer
+  -> IO Bool
+mutationEpochExists conn uid kind op idempotencyWindow = do
+  let identity =
+        unUserId uid <> "\NUL" <> kindLabel kind <> "\NUL" <> unOperationId op
+  _ <- query conn
+    "SELECT pg_advisory_xact_lock(hashtextextended(?, 0))"
+    (Only identity) :: IO [Only ()]
+  rows <- query conn
+    "SELECT 1 FROM mutations \
+    \WHERE user_id = ? AND kind = ? AND operation_id = ? \
+    \AND (state IN ('prepared', 'applying') \
+    \  OR external_state <> 'idle' \
+    \  OR updated_at >= now() - (? * interval '1 second'))"
+    (unUserId uid, kindLabel kind, unOperationId op, idempotencyWindow)
+      :: IO [Only Int]
+  pure (not (null rows))
+
 lookupObjectMeta :: Connection -> ObjectKey -> IO (Maybe (Integer, ContentSha256))
 lookupObjectMeta conn (ObjectKey key) = do
   rows <- query conn