Test immutable validation replacements

1 files changed, 56 insertions, 0 deletions

diff --git a/source/Test/Unit/Store.hs b/source/Test/Unit/Store.hs
index e1c6401..351a63b 100644
--- a/source/Test/Unit/Store.hs
+++ b/source/Test/Unit/Store.hs
@@ -96,6 +96,27 @@ roundTripsTypedRows =
                     (Semantic.proofSyntaxId "store-proof")
                     prefix
             proof = Semantic.proofValidationRecord proofKey certificate
+        replacementCertificate <- expectRight
+            (Authority.validationCertificate
+                authority
+                (Authority.CheckedSourceProof
+                    [Authority.preparedRequestId
+                        Authority.PreparedRequestFof
+                        Authority.PreparedRequestDirect
+                        "replacement"]))
+        let replacementKey =
+                Semantic.proofValidationKey
+                    (Identity.theoremId theorem)
+                    (Semantic.proofSyntaxId "store-proof-replacement")
+                    prefix
+            replacementProof =
+                Semantic.proofValidationRecord
+                    replacementKey
+                    replacementCertificate
+            bogusProof =
+                Semantic.proofValidationRecord
+                    proofKey
+                    replacementCertificate
             declarationKey =
                 Semantic.declarationValidationKey
                     (Semantic.declarationSyntaxId "store-declaration")
@@ -117,20 +138,49 @@ roundTripsTypedRows =
                 (Parsed.parsedModuleId parsedKey "store-parsed")
                 []
                 theory)
+        replacementArtifactKey <- expectRight
+            (Semantic.moduleArtifactKey
+                preludeModuleName
+                (Parsed.parsedModuleId
+                    parsedKey
+                    "store-parsed-replacement")
+                []
+                theory)
         let artifact =
                 Semantic.moduleArtifactResult
                     artifactKey
                     (Syntax.moduleSyntaxAssertedId syntax)
                     (Semantic.semanticInterfaceAssertedId semantic)
+            replacementArtifact =
+                Semantic.moduleArtifactResult
+                    replacementArtifactKey
+                    (Syntax.moduleSyntaxAssertedId syntax)
+                    (Semantic.semanticInterfaceAssertedId semantic)
         expectRightIO (Store.writeProofValidation store proof)
+        expectRightIO
+            (Store.writeProofValidation store replacementProof)
+        Store.writeProofValidation store bogusProof >>= \case
+            Left Store.StoreRowPayloadMismatch{} -> pure ()
+            Left other ->
+                assertFailure
+                    ("unexpected unequal proof replacement: "
+                        <> show other)
+            Right () ->
+                assertFailure "unequal proof replacement was accepted"
         expectRightIO (Store.writeDeclarationValidation store declaration)
         expectRightIO (Store.writeSyntaxInterface store syntax)
         expectRightIO (Store.writeSemanticInterface store semantic)
         expectRightIO (Store.writeModuleArtifactResult store artifact)
+        expectRightIO
+            (Store.writeModuleArtifactResult store replacementArtifact)
         assertEqual "proof validation row"
             (Just proof)
             =<< expectRightIO
                 (Store.loadProofValidation store proofKey)
+        assertEqual "replacement proof validation row"
+            (Just replacementProof)
+            =<< expectRightIO
+                (Store.loadProofValidation store replacementKey)
         assertEqual "declaration validation row"
             (Just declaration)
             =<< expectRightIO
@@ -153,6 +203,12 @@ roundTripsTypedRows =
                 (Store.loadModuleArtifactResult
                     store
                     (Semantic.moduleArtifactResultId artifact))
+        assertEqual "replacement module artifact row"
+            (Just replacementArtifact)
+            =<< expectRightIO
+                (Store.loadModuleArtifactResult
+                    store
+                    (Semantic.moduleArtifactResultId replacementArtifact))
         memo <- Store.newStoreMemo
         assertEqual "memoized artifact closure"
             (Right (Just artifact))