test: share cross-binding encoding vectors

bindings/haskell/conformance/README.md

@@ -0,0 +1,37 @@
+# Encoding conformance
+
+`encoding-v1.vectors` is the shared deterministic-CBOR byte corpus consumed by
+both the Rust engine boundary and the Haskell binding. It is the one place
+where the bytes of the `v1` wire format are written down, so a boundary change
+that only one side makes shows up as a failing test on that side.
+
+## Format
+
+Each line starts with a stable vector name followed by that vector's encoded
+bytes as decimal octets, separated by whitespace. Repeating a name continues
+the same vector on another line, so a long encoding stays inside a readable
+line width:
+
+```
+commit 133 1 103 97 99 99 111 117 110 116 99 111 110 101 0
+commit 129 131 103 67 114 101 97 116 101 100 99 49 46 48
+commit 66 0 1
+```
+
+The textual byte representation keeps boundary changes reviewable while still
+requiring both implementations to produce and accept the exact same CBOR bytes.
+
+## Append-only
+
+Vectors are append-only. A name that exists keeps its bytes: the `v1` format is
+what shipped bindings speak, and rewriting a vector silently redefines the
+contract instead of breaking the side that diverged. A new encoding gets a new
+name; a new wire format gets a new corpus file next to this one.
+
+## Consumers
+
+- The Rust ABI tests in `crates/event-sorcery-ffi` include this file at compile
+  time, relative to that crate's manifest directory.
+- The Haskell `wire-spec` suite reads it at test time as
+  `conformance/encoding-v1.vectors`, relative to the package root that Cabal
+  runs test suites from.

bindings/haskell/conformance/encoding-v1.vectors

@@ -0,0 +1,11 @@
+open-options 133 1 111 115 113 108 105 116 101 58 58 109
+open-options 101 109 111 114 121 58 25 19 136 1 25 1 0
+load-stream 132 1 103 97 99 99 111 117 110 116 99 111 110 101 246
+current-version 131 1 103 97 99 99 111 117 110 116 99 111 110 101
+commit 133 1 103 97 99 99 111 117 110 116 99 111 110 101 0
+commit 129 131 103 67 114 101 97 116 101 100 99 49 46 48
+commit 66 0 1
+stored-events 130 1 129 132 1 103 67 114 101 97 116 101
+stored-events 100 99 49 46 48 66 0 1
+conflict-error 131 1 2 132 103 97 99 99 111 117 110 116
+conflict-error 99 111 110 101 0 1

bindings/haskell/event-sorcery.cabal

@@ -1,16 +1,19 @@
-cabal-version: 3.0
-name:          event-sorcery
-version:       0.4.0.0
-synopsis:      Type-driven event sourcing over the event-sorcery engine
+cabal-version:      3.0
+name:               event-sorcery
+version:            0.4.0.0
+synopsis:           Type-driven event sourcing over the event-sorcery engine
 description:
   An idiomatic Haskell binding over the shared event-sorcery Rust engine.
 
-homepage:      https://github.com/dataclique/event-sorcery
-bug-reports:   https://github.com/dataclique/event-sorcery/issues
-license:       MIT
-license-file:  LICENSE
-build-type:    Simple
-category:      Database
+homepage:           https://github.com/dataclique/event-sorcery
+bug-reports:        https://github.com/dataclique/event-sorcery/issues
+license:            MIT
+license-file:       LICENSE
+build-type:         Simple
+category:           Database
+extra-source-files:
+  conformance/encoding-v1.vectors
+  conformance/README.md
 
 common strict
   default-language:   GHC2024

bindings/haskell/test/WireSpec.hs

@@ -55,9 +55,26 @@ import EventSorcery.Stream (
   encodeLoadStream,
   nextCursor,
  )
-import Test.Tasty (TestTree, defaultMain, testGroup)
+import Test.Tasty (TestTree, defaultMain, testGroup, withResource)
 import Test.Tasty.HUnit (Assertion, assertBool, assertFailure, testCase, (@?=))
-import Prelude (IO, Maybe (..), String, error, ($), (<>))
+import Prelude (
+  IO,
+  Maybe (..),
+  String,
+  const,
+  error,
+  lines,
+  map,
+  pure,
+  read,
+  readFile,
+  words,
+  ($),
+  (.),
+  (<$>),
+  (<>),
+  (==),
+ )
 
 
 main :: IO ()
@@ -219,9 +236,50 @@ tests =
         , testCase "unmodelled status" $
             decodeCloseStatus 42 @?= Left (UnknownEngineError 42)
         ]
+    , conformance
     ]
 
 
+-- | Drives the corpus both bindings share through this binding's codecs.
+--
+-- The fixtures above pin the shape this binding expects on its own terms. The
+-- corpus is the same bytes the Rust ABI asserts against, so a boundary change
+-- only one side made is a failure here rather than a runtime disagreement.
+conformance :: TestTree
+conformance =
+  withResource loadVectors (const (pure ())) $ \vectors ->
+    testGroup
+      "shared encoding conformance"
+      [ testCase "open options" $ do
+          expected <- conformanceVector "open-options" <$> vectors
+          encodeOpenOptions options @?= expected
+      , testCase "load stream without a cursor" $ do
+          expected <- conformanceVector "load-stream" <$> vectors
+          encodeLoadStream stream Nothing @?= expected
+      , testCase "current version" $ do
+          expected <- conformanceVector "current-version" <$> vectors
+          encodeCurrentVersion stream @?= expected
+      , testCase "commit" $ do
+          expected <- conformanceVector "commit" <$> vectors
+          encodeCommit stream 0 [proposed] @?= expected
+      , testCase "stored events" $ do
+          encoded <- conformanceVector "stored-events" <$> vectors
+          decodeStoredEvents encoded @?= Right [expectedStored]
+      , testCase "conflict error" $ do
+          encoded <- conformanceVector "conflict-error" <$> vectors
+          decodeEngineError 2 encoded
+            @?= Right
+              ( OptimisticConflict
+                  ( ConflictDetail
+                      (AggregateType "account")
+                      (AggregateId "one")
+                      0
+                      1
+                  )
+              )
+      ]
+
+
 -- | Pins a negative case to the rule it was written for.
 --
 -- The decoders report failures as text, and a fixture that is both malformed
@@ -237,6 +295,27 @@ assertDecodeFailure expected outcome =
     Right _ -> assertFailure ("expected a failure mentioning " <> expected)
 
 
+-- | Reads the corpus from the package root Cabal runs test suites from.
+loadVectors :: IO [(String, ByteString)]
+loadVectors =
+  map decodeVector . lines <$> readFile "conformance/encoding-v1.vectors"
+
+
+-- | Takes one corpus line as a vector name and its decimal octets.
+decodeVector :: String -> (String, ByteString)
+decodeVector encoded = case words encoded of
+  [] -> error "empty conformance vector"
+  name : octets -> (name, ByteString.pack (map read octets))
+
+
+-- | Joins every line the corpus records under one vector name.
+conformanceVector :: String -> [(String, ByteString)] -> ByteString
+conformanceVector name vectors =
+  case [octets | (vectorName, octets) <- vectors, vectorName == name] of
+    [] -> error ("missing conformance vector: " <> name)
+    chunks -> ByteString.concat chunks
+
+
 options :: OpenOptions
 options = OpenOptions "sqlite::memory:" 5000 1 256
 

crates/event-sorcery-ffi/src/lib.rs

@@ -2424,6 +2424,28 @@ mod tests {
 
     use super::*;
 
+    /// The corpus both bindings encode against, shared with the Haskell suite.
+    const ENCODING_VECTORS: &str = include_str!(concat!(
+        env!("CARGO_MANIFEST_DIR"),
+        "/../../bindings/haskell/conformance/encoding-v1.vectors"
+    ));
+
+    /// Joins every corpus line recorded under one vector name.
+    fn conformance_vector(name: &str) -> Vec<u8> {
+        let bytes: Vec<u8> = ENCODING_VECTORS
+            .lines()
+            .filter_map(|line| {
+                let mut fields = line.split_ascii_whitespace();
+                (fields.next() == Some(name)).then_some(fields)
+            })
+            .flatten()
+            .map(|octet| octet.parse::<u8>().expect("conformance octet"))
+            .collect();
+
+        assert!(!bytes.is_empty(), "missing conformance vector: {name}");
+        bytes
+    }
+
     fn empty_buffer() -> EsBuf {
         EsBuf {
             ptr: ptr::null_mut(),
@@ -2646,6 +2668,37 @@ mod tests {
         token
     }
 
+    #[test]
+    fn codecs_match_the_shared_conformance_corpus() {
+        let proposed = ("Created", "1.0", OpaqueBytes(vec![0, 1]));
+        let stored = (1_u64, "Created", "1.0", OpaqueBytes(vec![0, 1]));
+
+        assert_eq!(
+            encode_request(&(1_u8, "sqlite::memory:", 5_000_u64, 1_u32, 256_u32)),
+            conformance_vector("open-options")
+        );
+        assert_eq!(
+            encode_request(&(1_u8, "account", "one", Option::<u64>::None)),
+            conformance_vector("load-stream")
+        );
+        assert_eq!(
+            encode_request(&(1_u8, "account", "one")),
+            conformance_vector("current-version")
+        );
+        assert_eq!(
+            encode_request(&(1_u8, "account", "one", 0_u64, vec![proposed])),
+            conformance_vector("commit")
+        );
+        assert_eq!(
+            encode_request(&(1_u8, vec![stored])),
+            conformance_vector("stored-events")
+        );
+        assert_eq!(
+            encode_request(&(1_u8, ES_ERR_CONFLICT, ("account", "one", 0_u64, 1_u64))),
+            conformance_vector("conflict-error")
+        );
+    }
+
     #[test]
     fn opens_migrates_and_closes_an_in_memory_store() {
         let mut store = ptr::null_mut();

flake.nix

@@ -69,11 +69,12 @@
           };
         };
         engineSource = pkgs.runCommand "event-sorcery-engine-source" { } ''
-          mkdir -p $out
+          mkdir -p $out/bindings/haskell
           cp ${./Cargo.toml} $out/Cargo.toml
           cp ${./Cargo.lock} $out/Cargo.lock
           cp -R ${./crates} $out/crates
           cp -R ${./.sqlx} $out/.sqlx
+          cp -R ${./bindings/haskell/conformance} $out/bindings/haskell/conformance
         '';
         ffiEngine = pkgs.rustPlatform.buildRustPackage {
           pname = "event-sorcery-ffi";