Type protocol persistence around model phases

test/RecoveryPhase.hs

@@ -112,16 +112,15 @@ preparePut database redis name size identity = do
   outcome <- withTransaction database $ \connection ->
     admitMutation
       connection
-      recoveryUser
-      Put
-      (phaseOperation name)
-      sharedPool
-      (phaseKey name)
-      (RelativePath (name <> ".bin"))
-      size
-      (Just identity)
-      (1024 * 1024 * 1024)
-      3600
+      AdmissionRequest
+        { admissionIdentity =
+            AdmissionIdentity recoveryUser Put (phaseOperation name)
+        , admissionPoolId = sharedPool
+        , admissionRelativePath = RelativePath (name <> ".bin")
+        , admissionFingerprint =
+            MutationFingerprint Put (phaseKey name) size (Just identity)
+        }
+      (AdmissionLimits (1024 * 1024 * 1024) 3600)
   prepared outcome
 
 prepareDelete :: Config -> Db -> Redis -> S3 -> IO MutationRecord
@@ -146,16 +145,18 @@ prepareDelete cfg database redis store = do
   outcome <- withTransaction database $ \connection ->
     admitMutation
       connection
-      recoveryUser
-      Delete
-      (phaseOperation name)
-      sharedPool
-      key
-      (RelativePath (name <> ".bin"))
-      0
-      Nothing
-      (cfgMaxObjectBytes cfg)
-      (cfgIdempotencyWindowSec cfg)
+      AdmissionRequest
+        { admissionIdentity =
+            AdmissionIdentity recoveryUser Delete (phaseOperation name)
+        , admissionPoolId = sharedPool
+        , admissionRelativePath = RelativePath (name <> ".bin")
+        , admissionFingerprint =
+            MutationFingerprint Delete key 0 Nothing
+        }
+      AdmissionLimits
+        { admissionMaxObjectBytes = cfgMaxObjectBytes cfg
+        , admissionIdempotencyWindowSec = cfgIdempotencyWindowSec cfg
+        }
   prepared outcome
 
 beginDispatch :: Config -> Db -> MutationRecord -> IO ()
@@ -165,8 +166,10 @@ beginDispatch cfg database rec = do
     pending <- markExternalPending
       connection
       rec
-      (cfgObjectRequestTimeoutSec cfg * 2)
-      (cfgRecoveryGraceSec cfg)
+      DispatchTiming
+        { dispatchSettlementBoundSec = cfgObjectRequestTimeoutSec cfg * 2
+        , dispatchWorkerGraceSec = cfgRecoveryGraceSec cfg
+        }
     pure (applying && pending)
   unless started (fail "could not begin dispatch")