Type protocol persistence around model phases

test/ProtocolConformance.hs

@@ -457,7 +457,7 @@ dispatch :: Db -> MutationRecord -> IO ()
 dispatch database record = do
   ok <- withTransaction database $ \connection -> do
     applying <- markApplying connection record
-    pending <- markExternalPending connection record 10 5
+    pending <- markExternalPending connection record (DispatchTiming 10 5)
     pure (applying && pending)
   assert "PrepareEffect/DispatchEffect" ok
   coveredAction "PrepareEffect"
@@ -498,48 +498,59 @@ admitPut cfg database operation path size identity =
   withTransaction database $ \connection ->
     admitMutation
       connection
-      protocolUser
-      Put
-      (OperationId operation)
-      sharedPool
-      (ObjectKey ("shared/" <> path))
-      (RelativePath path)
-      size
-      (Just identity)
-      (cfgMaxObjectBytes cfg)
-      (cfgIdempotencyWindowSec cfg)
+      AdmissionRequest
+        { admissionIdentity =
+            AdmissionIdentity protocolUser Put (OperationId operation)
+        , admissionPoolId = sharedPool
+        , admissionRelativePath = RelativePath path
+        , admissionFingerprint =
+            MutationFingerprint Put (ObjectKey ("shared/" <> path)) size
+              (Just identity)
+        }
+      AdmissionLimits
+        { admissionMaxObjectBytes = cfgMaxObjectBytes cfg
+        , admissionIdempotencyWindowSec = cfgIdempotencyWindowSec cfg
+        }
 
 admitDelete :: Config -> Db -> Text -> Text -> IO AdmitOutcome
 admitDelete cfg database operation path =
   withTransaction database $ \connection ->
     admitMutation
       connection
-      protocolUser
-      Delete
-      (OperationId operation)
-      sharedPool
-      (ObjectKey ("shared/" <> path))
-      (RelativePath path)
-      0
-      Nothing
-      (cfgMaxObjectBytes cfg)
-      (cfgIdempotencyWindowSec cfg)
+      AdmissionRequest
+        { admissionIdentity =
+            AdmissionIdentity protocolUser Delete (OperationId operation)
+        , admissionPoolId = sharedPool
+        , admissionRelativePath = RelativePath path
+        , admissionFingerprint =
+            MutationFingerprint Delete (ObjectKey ("shared/" <> path)) 0 Nothing
+        }
+      AdmissionLimits
+        { admissionMaxObjectBytes = cfgMaxObjectBytes cfg
+        , admissionIdempotencyWindowSec = cfgIdempotencyWindowSec cfg
+        }
 
 admitPersonal :: Config -> Db -> UserId -> Text -> IO AdmitOutcome
 admitPersonal cfg database user operation =
   withTransaction database $ \connection ->
     admitMutation
       connection
-      user
-      Put
-      (OperationId operation)
-      (personalPool user)
-      (ObjectKey ("users/" <> unUserId user <> "/file.bin"))
-      (RelativePath "file.bin")
-      9
-      (Just identityA)
-      (cfgMaxObjectBytes cfg)
-      (cfgIdempotencyWindowSec cfg)
+      AdmissionRequest
+        { admissionIdentity =
+            AdmissionIdentity user Put (OperationId operation)
+        , admissionPoolId = personalPool user
+        , admissionRelativePath = RelativePath "file.bin"
+        , admissionFingerprint =
+            MutationFingerprint
+              Put
+              (ObjectKey ("users/" <> unUserId user <> "/file.bin"))
+              9
+              (Just identityA)
+        }
+      AdmissionLimits
+        { admissionMaxObjectBytes = cfgMaxObjectBytes cfg
+        , admissionIdempotencyWindowSec = cfgIdempotencyWindowSec cfg
+        }
 
 seedObject :: Db -> S3 -> Text -> BL.ByteString -> IO ()
 seedObject database store path body = do