Establish canonical identity codecs

7 files changed, 630 insertions, 58 deletions

diff --git a/package.yaml b/package.yaml
index c9ac0af..cac503f 100644
--- a/package.yaml
+++ b/package.yaml
@@ -26,6 +26,7 @@ dependencies:
     - hashable >= 1.3.1.0 # 1.3.1.0 provides Hashable1 for NonEmpty
     - hedgehog
     - lucid2
+    - memory
     - megaparsec
     - monad-logger
     - mtl
diff --git a/source/Checking/Transition.hs b/source/Checking/Transition.hs
index fdb56d2..9551bf4 100644
--- a/source/Checking/Transition.hs
+++ b/source/Checking/Transition.hs
@@ -6,7 +6,7 @@
 module Checking.Transition
     ( ModuleName
     , moduleName
-    , moduleNameMount
+    , moduleNameNamespace
     , moduleNameRelativePath
     , LocalDeclarationOrdinal
     , localDeclarationOrdinalValue
@@ -101,58 +101,21 @@ import Checking.Foundation
     )
 import Checking.Kernel.Derivation
 import Checking.Legacy
-import Felix.Source
+import Felix.Module
 import Provers qualified
 import Report.Location
 import Syntax.Internal
 
-import Control.Monad (foldM, unless, when)
+import Control.Monad (foldM, unless)
 import Data.Bifunctor (first)
 import Data.Map.Strict qualified as Map
 import Data.Sequence qualified as Seq
 import Data.Set qualified as Set
 import Data.Vector (Vector)
 import Data.Vector qualified as Vector
-import Data.Word (Word32)
 import Numeric.Natural (Natural)
 
 
-data ModuleName = ModuleName
-    !SourceMountId
-    !SafeRelativePath
-    deriving stock (Show, Eq, Ord)
-
-moduleName :: ResolvedSourceAddress -> ModuleName
-moduleName address =
-    ModuleName
-        (sourceAddressMount address)
-        (sourceAddressRelativePath address)
-
-moduleNameMount :: ModuleName -> SourceMountId
-moduleNameMount (ModuleName mount _relativePath) =
-    mount
-
-moduleNameRelativePath :: ModuleName -> SafeRelativePath
-moduleNameRelativePath (ModuleName _mount relativePath) =
-    relativePath
-
-newtype LocalDeclarationOrdinal =
-    LocalDeclarationOrdinal Natural
-    deriving stock (Show, Eq, Ord)
-
-localDeclarationOrdinal
-    :: Natural
-    -> LocalDeclarationOrdinal
-localDeclarationOrdinal =
-    LocalDeclarationOrdinal
-
-localDeclarationOrdinalValue
-    :: LocalDeclarationOrdinal
-    -> Natural
-localDeclarationOrdinalValue
-        (LocalDeclarationOrdinal ordinal) =
-    ordinal
-
 data OpaqueDeclarationRef = OpaqueDeclarationRef
     !ModuleName
     !LocalDeclarationOrdinal
@@ -204,14 +167,6 @@ checkedGlobalType
         (CheckedOpaqueGlobal _reference coreType) =
     coreType
 
-newtype LocalFactOrdinal =
-    LocalFactOrdinal Word32
-    deriving stock (Show, Eq, Ord)
-
-localFactOrdinalValue :: LocalFactOrdinal -> Word32
-localFactOrdinalValue (LocalFactOrdinal ordinal) =
-    ordinal
-
 newtype LocalAssumptionOrdinal =
     LocalAssumptionOrdinal Natural
     deriving stock (Show, Eq, Ord)
@@ -1901,16 +1856,10 @@ nextTransitionTypedFactReference builder = do
             (transitionCurrentDeclarationReference builder))
     let ordinal =
             builderNextTypedFact builder
-    when
-        (ordinal > fromIntegral (maxBound :: Word32))
-        (Left
-            (TransitionTypedFactOrdinalSpaceExhausted
-                (builderName builder)))
     pure
         (FactRef
             (builderName builder)
-            (LocalFactOrdinal
-                (fromIntegral ordinal)))
+            (localFactOrdinal ordinal))
 
 commitTransitionTypedDeclaredAssumption
     :: NonEmpty Marker
@@ -2652,8 +2601,6 @@ data TransitionModuleError
         !TransitionFactRef
     | TransitionDependencyNotMigrated
         !TransitionFactRef
-    | TransitionTypedFactOrdinalSpaceExhausted
-        !ModuleName
     | TransitionTypedDirectAxiomManifestMismatch
     | TransitionFactReferenceConflict
         !TransitionFactRef
diff --git a/source/Felix/Math/Codec.hs b/source/Felix/Math/Codec.hs
new file mode 100644
index 0000000..001ef26
--- /dev/null
+++ b/source/Felix/Math/Codec.hs
@@ -0,0 +1,238 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Stable byte primitives used only by durable mathematical identities.
+module Felix.Math.Codec
+    ( MathematicalDigest
+    , mathematicalDigestBytes
+    , mathematicalDigestFromBytes
+    , mathematicalDigestHex
+    , hashCanonicalFields
+    , encodeU32
+    , encodeU64
+    , encodeFrame
+    , encodeNatural
+    , encodeInteger
+    , encodeSequence
+    , encodeCanonicalPathRecord
+    , encodeCanonicalSet
+    , encodeCanonicalMap
+    , MathematicalCodecError(..)
+    ) where
+
+import Base
+
+import Crypto.Hash qualified as Crypto
+import Data.Bits ((.&.), shiftR)
+import Data.ByteArray qualified as ByteArray
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as ByteString
+import Data.ByteString.Builder qualified as Builder
+import Data.ByteString.Lazy qualified as LazyByteString
+import Data.List qualified as List
+import Data.Text qualified as Text
+import Data.Text.Encoding qualified as Text
+import Data.Word (Word32)
+import Numeric.Natural (Natural)
+
+
+-- | One raw SHA-256 digest. Hexadecimal is presentation only.
+newtype MathematicalDigest =
+    MathematicalDigest ByteString
+    deriving stock (Eq, Ord)
+
+instance Show MathematicalDigest where
+    show =
+        Text.unpack . mathematicalDigestHex
+
+mathematicalDigestBytes :: MathematicalDigest -> ByteString
+mathematicalDigestBytes (MathematicalDigest bytes) =
+    bytes
+
+mathematicalDigestFromBytes :: ByteString -> Maybe MathematicalDigest
+mathematicalDigestFromBytes bytes
+    | ByteString.length bytes == 32 =
+        Just (MathematicalDigest bytes)
+    | otherwise =
+        Nothing
+
+mathematicalDigestHex :: MathematicalDigest -> Text
+mathematicalDigestHex =
+    Text.decodeUtf8
+        . ByteString.concatMap encodeHexByte
+        . mathematicalDigestBytes
+  where
+    encodeHexByte byte =
+        ByteString.pack
+            [ hexDigit (byte `shiftR` 4)
+            , hexDigit (byte .&. 0x0f)
+            ]
+
+    hexDigit nibble
+        | nibble < 10 =
+            48 + nibble
+        | otherwise =
+            87 + nibble
+
+
+data MathematicalCodecError
+    = CanonicalFieldCountOverflow !Integer
+    | CanonicalSequenceCountOverflow !Integer
+    | CanonicalPathComponentCountOverflow !Integer
+    | DuplicateCanonicalSetElement !ByteString
+    | DuplicateCanonicalMapKey !ByteString
+    deriving stock (Show, Eq)
+
+-- | The sole durable hash framing primitive.
+hashCanonicalFields
+    :: Text
+    -> [ByteString]
+    -> Either MathematicalCodecError MathematicalDigest
+hashCanonicalFields domain fields = do
+    fieldCount <- checkedU32
+        CanonicalFieldCountOverflow
+        (length fields)
+    let input =
+            encodeFrame (Text.encodeUtf8 domain)
+                <> encodeU32 fieldCount
+                <> foldMap encodeFrame fields
+        digest =
+            Crypto.hash input
+                :: Crypto.Digest Crypto.SHA256
+    pure
+        (MathematicalDigest
+            (ByteArray.convert digest))
+
+encodeU32 :: Word32 -> ByteString
+encodeU32 =
+    strictBuilder . Builder.word32BE
+
+encodeU64 :: Word64 -> ByteString
+encodeU64 =
+    strictBuilder . Builder.word64BE
+
+encodeFrame :: ByteString -> ByteString
+encodeFrame bytes =
+    encodeU64 (fromIntegral (ByteString.length bytes))
+        <> bytes
+
+-- | Minimal unsigned big-endian magnitude, framed by its byte length.
+encodeNatural :: Natural -> ByteString
+encodeNatural number =
+    encodeU64 (fromIntegral (ByteString.length magnitude))
+        <> magnitude
+  where
+    magnitude
+        | number == 0 =
+            ByteString.empty
+        | otherwise =
+            ByteString.reverse
+                (ByteString.unfoldr step number)
+
+    step 0 =
+        Nothing
+    step remaining =
+        Just
+            ( fromIntegral (remaining .&. 0xff)
+            , remaining `shiftR` 8
+            )
+
+encodeInteger :: Integer -> ByteString
+encodeInteger integer
+    | integer < 0 =
+        ByteString.cons 0x01
+            (encodeNatural (fromInteger (negate integer)))
+    | otherwise =
+        ByteString.cons 0x00
+            (encodeNatural (fromInteger integer))
+
+encodeSequence
+    :: [ByteString]
+    -> Either MathematicalCodecError ByteString
+encodeSequence elements = do
+    elementCount <- checkedU64
+        CanonicalSequenceCountOverflow
+        (length elements)
+    pure
+        (encodeU64 elementCount
+            <> foldMap encodeFrame elements)
+
+-- | Encode an already validated path-component vector under its exact domain.
+encodeCanonicalPathRecord
+    :: Text
+    -> [Text]
+    -> Either MathematicalCodecError ByteString
+encodeCanonicalPathRecord domain components = do
+    componentCount <- checkedU32
+        CanonicalPathComponentCountOverflow
+        (length components)
+    pure
+        (encodeFrame (Text.encodeUtf8 domain)
+            <> encodeU32 componentCount
+            <> foldMap
+                (encodeFrame . Text.encodeUtf8)
+                components)
+
+encodeCanonicalSet
+    :: [ByteString]
+    -> Either MathematicalCodecError ByteString
+encodeCanonicalSet elements = do
+    let ordered = List.sort elements
+    case firstAdjacentDuplicate ordered of
+        Just duplicate ->
+            Left (DuplicateCanonicalSetElement duplicate)
+        Nothing ->
+            encodeSequence ordered
+
+encodeCanonicalMap
+    :: [(ByteString, ByteString)]
+    -> Either MathematicalCodecError ByteString
+encodeCanonicalMap entries = do
+    let ordered =
+            List.sortOn fst entries
+    case firstAdjacentDuplicate (fst <$> ordered) of
+        Just duplicate ->
+            Left (DuplicateCanonicalMapKey duplicate)
+        Nothing ->
+            encodeSequence
+                [ encodeFrame key <> encodeFrame value
+                | (key, value) <- ordered
+                ]
+
+strictBuilder :: Builder.Builder -> ByteString
+strictBuilder =
+    LazyByteString.toStrict . Builder.toLazyByteString
+
+checkedU32
+    :: (Integer -> MathematicalCodecError)
+    -> Int
+    -> Either MathematicalCodecError Word32
+checkedU32 makeError suppliedCount
+    | suppliedCountInteger > toInteger (maxBound :: Word32) =
+        Left (makeError suppliedCountInteger)
+    | otherwise =
+        Right (fromIntegral suppliedCount)
+  where
+    suppliedCountInteger = toInteger suppliedCount
+
+checkedU64
+    :: (Integer -> MathematicalCodecError)
+    -> Int
+    -> Either MathematicalCodecError Word64
+checkedU64 makeError suppliedCount
+    | suppliedCountInteger > toInteger (maxBound :: Word64) =
+        Left (makeError suppliedCountInteger)
+    | otherwise =
+        Right (fromIntegral suppliedCount)
+  where
+    suppliedCountInteger = toInteger suppliedCount
+
+firstAdjacentDuplicate :: Eq a => [a] -> Maybe a
+firstAdjacentDuplicate = \case
+    left : right : rest
+        | left == right ->
+            Just left
+        | otherwise ->
+            firstAdjacentDuplicate (right : rest)
+    _ ->
+        Nothing
diff --git a/source/Felix/Module.hs b/source/Felix/Module.hs
new file mode 100644
index 0000000..9d73e08
--- /dev/null
+++ b/source/Felix/Module.hs
@@ -0,0 +1,196 @@
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE NoImplicitPrelude #-}
+
+-- | Durable logical module owners, independent of invocation-local mount IDs.
+module Felix.Module
+    ( SourceNamespaceId
+    , sourceNamespaceId
+    , sourceNamespaceDigest
+    , ModuleName
+    , moduleName
+    , moduleNameNamespace
+    , moduleNameRelativePath
+    , encodeAbsoluteSourceRoot
+    , encodeSafeRelativePath
+    , encodeModuleName
+    , LocalDeclarationOrdinal
+    , localDeclarationOrdinal
+    , localDeclarationOrdinalValue
+    , LocalFactOrdinal
+    , localFactOrdinal
+    , localFactOrdinalValue
+    , GeneratedObjectSlot
+    , generatedObjectSlot
+    , generatedObjectSlotValue
+    , DeclarationFamilyTag(..)
+    , encodeDeclarationFamilyTag
+    ) where
+
+import Base
+import Felix.Math.Codec
+import Felix.Source
+
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as ByteString
+import Data.Text qualified as Text
+import Numeric.Natural (Natural)
+import System.FilePath.Posix qualified as Posix
+
+
+newtype SourceNamespaceId =
+    SourceNamespaceId MathematicalDigest
+    deriving stock (Show, Eq, Ord)
+
+sourceNamespaceId :: CanonicalPath -> SourceNamespaceId
+sourceNamespaceId root =
+    SourceNamespaceId
+        (codecInvariant
+            (hashCanonicalFields
+                "felix-source-namespace-v1"
+                [encodeAbsoluteSourceRoot root]))
+
+sourceNamespaceDigest :: SourceNamespaceId -> MathematicalDigest
+sourceNamespaceDigest (SourceNamespaceId digest) =
+    digest
+
+data ModuleName = ModuleName
+    !SourceNamespaceId
+    !SafeRelativePath
+    deriving stock (Show, Eq, Ord)
+
+moduleName :: ResolvedSourceAddress -> ModuleName
+moduleName address =
+    ModuleName
+        (sourceNamespaceId (sourceAddressRoot address))
+        (sourceAddressRelativePath address)
+
+moduleNameNamespace :: ModuleName -> SourceNamespaceId
+moduleNameNamespace (ModuleName namespace _relativePath) =
+    namespace
+
+moduleNameRelativePath :: ModuleName -> SafeRelativePath
+moduleNameRelativePath (ModuleName _namespace relativePath) =
+    relativePath
+
+encodeAbsoluteSourceRoot :: CanonicalPath -> ByteString
+encodeAbsoluteSourceRoot root =
+    encodePath
+        "felix-absolute-source-root-path-v1"
+        components
+  where
+    path =
+        Posix.dropTrailingPathSeparator
+            (canonicalPathFilePath root)
+    components =
+        case Posix.splitDirectories path of
+            [] ->
+                []
+            rootComponent : rest
+                | endsInPathSeparator rootComponent ->
+                        rest
+                | otherwise ->
+                    impossible
+                        "canonical source root is not absolute"
+
+    endsInPathSeparator component =
+        case reverse component of
+            character : _ ->
+                Posix.isPathSeparator character
+            [] ->
+                False
+
+encodeSafeRelativePath :: SafeRelativePath -> ByteString
+encodeSafeRelativePath relative =
+    encodePath
+        "felix-safe-relative-path-v1"
+        (splitComponents
+            (safeRelativePathFilePath relative))
+
+encodeModuleName :: ModuleName -> ByteString
+encodeModuleName (ModuleName namespace relative) =
+    mathematicalDigestBytes (sourceNamespaceDigest namespace)
+        <> encodeSafeRelativePath relative
+
+encodePath :: Text -> [FilePath] -> ByteString
+encodePath domain components =
+    codecInvariant
+        (encodeCanonicalPathRecord
+            domain
+            (Text.pack <$> components))
+
+splitComponents :: FilePath -> [FilePath]
+splitComponents path =
+    case break (== '/') path of
+        (component, []) ->
+            [component]
+        (component, _slash : rest) ->
+            component : splitComponents rest
+
+
+newtype LocalDeclarationOrdinal =
+    LocalDeclarationOrdinal Natural
+    deriving stock (Show, Eq, Ord)
+
+localDeclarationOrdinal
+    :: Natural
+    -> LocalDeclarationOrdinal
+localDeclarationOrdinal =
+    LocalDeclarationOrdinal
+
+localDeclarationOrdinalValue
+    :: LocalDeclarationOrdinal
+    -> Natural
+localDeclarationOrdinalValue
+        (LocalDeclarationOrdinal ordinal) =
+    ordinal
+
+newtype LocalFactOrdinal =
+    LocalFactOrdinal Natural
+    deriving stock (Show, Eq, Ord)
+
+localFactOrdinal :: Natural -> LocalFactOrdinal
+localFactOrdinal =
+    LocalFactOrdinal
+
+localFactOrdinalValue :: LocalFactOrdinal -> Natural
+localFactOrdinalValue (LocalFactOrdinal ordinal) =
+    ordinal
+
+newtype GeneratedObjectSlot =
+    GeneratedObjectSlot Natural
+    deriving stock (Show, Eq, Ord)
+
+generatedObjectSlot :: Natural -> GeneratedObjectSlot
+generatedObjectSlot =
+    GeneratedObjectSlot
+
+generatedObjectSlotValue :: GeneratedObjectSlot -> Natural
+generatedObjectSlotValue (GeneratedObjectSlot slot) =
+    slot
+
+data DeclarationFamilyTag
+    = SignatureDeclaration
+    | StructureDeclaration
+    | DatatypeDeclaration
+    | InductiveDeclaration
+    deriving stock (Show, Eq, Ord, Enum, Bounded)
+
+encodeDeclarationFamilyTag :: DeclarationFamilyTag -> ByteString
+encodeDeclarationFamilyTag =
+    ByteString.singleton . \case
+        SignatureDeclaration ->
+            0x00
+        StructureDeclaration ->
+            0x01
+        DatatypeDeclaration ->
+            0x02
+        InductiveDeclaration ->
+            0x03
+
+codecInvariant
+    :: Either MathematicalCodecError value
+    -> value
+codecInvariant =
+    either
+        (impossible . ("canonical codec invariant: " <>) . show)
+        id
diff --git a/source/Felix/Source.hs b/source/Felix/Source.hs
index f356d8d..3be3c46 100644
--- a/source/Felix/Source.hs
+++ b/source/Felix/Source.hs
@@ -74,6 +74,7 @@ import Control.DeepSeq (NFData)
 import Control.Exception (Exception, IOException, displayException, try)
 import Data.Bifunctor (first)
 import Data.ByteString qualified as ByteString
+import Data.Char (ord)
 import Data.List qualified as List
 import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
@@ -122,6 +123,7 @@ data RelativePathError
     | CurrentDirectoryComponent
     | ParentDirectoryComponent
     | NullPathCharacter
+    | NonUnicodeScalarPathCharacter
     deriving stock (Show, Eq)
 
 safeRelativePath :: FilePath -> Either RelativePathError SafeRelativePath
@@ -132,6 +134,8 @@ safeRelativePath path
         Left AbsoluteRelativePath
     | '\0' `elem` path =
         Left NullPathCharacter
+    | any (not . isUnicodeScalar) path =
+        Left NonUnicodeScalarPathCharacter
     | any null components =
         Left EmptyPathComponent
     | "." `elem` components =
@@ -391,6 +395,7 @@ data SourceError
     | DuplicateSourceMountId !SourceMountId
     | SourceMountCanonicalizationFailed !SourceMountId !FilePath !Text
     | SourceMountInspectionFailed !SourceMountId !FilePath !Text
+    | CanonicalPathContainsNonUnicodeScalar !FilePath
     | SourceMountNotDirectory
         !SourceMountId
         !FilePath
@@ -515,7 +520,16 @@ canonicalize makeError path = do
         Left err ->
             Left (makeError path (Text.pack (displayException err)))
         Right canonical ->
-            Right (CanonicalPath canonical)
+            if all isUnicodeScalar canonical
+                then Right (CanonicalPath canonical)
+                else Left
+                    (CanonicalPathContainsNonUnicodeScalar canonical)
+
+isUnicodeScalar :: Char -> Bool
+isUnicodeScalar character =
+    let codePoint = ord character
+    in codePoint < 0xd800
+        || codePoint > 0xdfff
 
 firstDuplicate :: Ord a => [a] -> Maybe a
 firstDuplicate = go mempty
diff --git a/source/Test/Unit.hs b/source/Test/Unit.hs
index 01fb96a..d21cde1 100644
--- a/source/Test/Unit.hs
+++ b/source/Test/Unit.hs
@@ -11,6 +11,7 @@ import Test.Unit.Concrete qualified as Concrete
 import Test.Unit.Core qualified as Core
 import Test.Unit.Encoding qualified as Encoding
 import Test.Unit.Foundation qualified as Foundation
+import Test.Unit.Identity qualified as Identity
 import Test.Unit.Html qualified as Html
 import Test.Unit.HtmlLayout qualified as HtmlLayout
 import Test.Unit.HtmlOutput qualified as HtmlOutput
@@ -34,6 +35,7 @@ unitTests = testGroup "unit tests"
     , Core.unitTests
     , Encoding.unitTests
     , Foundation.unitTests
+    , Identity.unitTests
     , Html.unitTests
     , HtmlLayout.unitTests
     , HtmlOutput.unitTests
diff --git a/source/Test/Unit/Identity.hs b/source/Test/Unit/Identity.hs
new file mode 100644
index 0000000..1482f16
--- /dev/null
+++ b/source/Test/Unit/Identity.hs
@@ -0,0 +1,174 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+module Test.Unit.Identity (unitTests) where
+
+import Base
+import Felix.Math.Codec
+import Felix.Module
+import Felix.Source
+
+import Control.Exception (bracket)
+import Data.ByteString qualified as ByteString
+import Data.Text qualified as Text
+import System.Directory qualified as Directory
+import System.FilePath.Posix qualified as Posix
+import Test.Tasty
+import Test.Tasty.HUnit
+
+
+unitTests :: TestTree
+unitTests =
+    testGroup "Content identities"
+        [ testCase "uses the frozen mathematical hash framing"
+            hashesCanonicalFields
+        , testCase "uses the frozen source path codecs"
+            encodesSourcePaths
+        , testCase "separates durable namespaces from mount labels"
+            separatesModuleOwnership
+        , testCase "rejects duplicate canonical collection encodings"
+            rejectsDuplicateCanonicalCollections
+        ]
+
+hashesCanonicalFields :: Assertion
+hashesCanonicalFields = do
+    let vectors =
+            [ ( []
+              , "09ace37213e33d80b79e5f21fd60d03f25855e528cc2f25da4762be81d34a8c2"
+              )
+            , ( [ByteString.empty]
+              , "cd166f5b566ebd02f00f202792699803df09e9a020afbaaa987f5001cb1d095e"
+              )
+            , (["a", "bc"]
+              , "70c43385ae5b28bb862bc461a3c8d85ab94fd616528e7d94a9e7a52217b5c657"
+              )
+            , (["ab", "c"]
+              , "d3588d1b26aac958d9f393d8528ad68ed34354aee41d7e405a156b3ffff20c90"
+              )
+            ]
+    traverse_
+        (\(fields, expected) -> do
+            digest <- expectRight
+                (hashCanonicalFields "felix-test-v1" fields)
+            assertEqual
+                ("fields " <> show fields)
+                expected
+                (mathematicalDigestHex digest))
+        vectors
+
+encodesSourcePaths :: Assertion
+encodesSourcePaths = do
+    let absoluteVectors =
+            [ ([]
+              , "000000000000002266656c69782d6162736f6c7574652d736f757263652d726f6f742d706174682d763100000000"
+              )
+            , (["a"]
+              , "000000000000002266656c69782d6162736f6c7574652d736f757263652d726f6f742d706174682d763100000001000000000000000161"
+              )
+            , (["a", "b"]
+              , "000000000000002266656c69782d6162736f6c7574652d736f757263652d726f6f742d706174682d763100000002000000000000000161000000000000000162"
+              )
+            ]
+        relativeVectors =
+            [ (["a"]
+              , "000000000000001b66656c69782d736166652d72656c61746976652d706174682d763100000001000000000000000161"
+              )
+            , (["a", "b"]
+              , "000000000000001b66656c69782d736166652d72656c61746976652d706174682d763100000002000000000000000161000000000000000162"
+              )
+            ]
+    traverse_
+        (\(components, expected) -> do
+            encoded <- expectRight
+                (encodeCanonicalPathRecord
+                    "felix-absolute-source-root-path-v1"
+                    components)
+            assertEqual
+                (show components)
+                expected
+                (hex encoded))
+        absoluteVectors
+    traverse_
+        (\(components, expected) -> do
+            encoded <- expectRight
+                (encodeCanonicalPathRecord
+                    "felix-safe-relative-path-v1"
+                    components)
+            assertEqual
+                (show components)
+                expected
+                (hex encoded))
+        relativeVectors
+
+separatesModuleOwnership :: Assertion
+separatesModuleOwnership =
+    withTemporaryDirectory "felix-module-owner" \root -> do
+        writeFile (root Posix.</> "b.tex") ""
+        mounts <- expectRight
+            =<< prepareSourceMounts
+                [(sourceMountId "display-only", root)]
+        request <- expectRight (searchedRoot "b.tex")
+        source <- expectRight =<< resolveRoot mounts request
+        mount <- case sourceMountList mounts of
+            [only] ->
+                pure only
+            _ ->
+                assertFailure "expected one prepared mount"
+                    >> fail "unreachable"
+        relative <- expectRight (safeRelativePath "b.tex")
+        let owner =
+                moduleName (resolvedSourceAddress source)
+        assertEqual
+            "relative owner"
+            relative
+            (moduleNameRelativePath owner)
+        assertEqual
+            "namespace derives from the canonical root"
+            (sourceNamespaceId (sourceMountRoot mount))
+            (moduleNameNamespace owner)
+
+rejectsDuplicateCanonicalCollections :: Assertion
+rejectsDuplicateCanonicalCollections = do
+    assertEqual
+        "set duplicate"
+        (Left (DuplicateCanonicalSetElement "a"))
+        (encodeCanonicalSet ["b", "a", "a"])
+    assertEqual
+        "map duplicate"
+        (Left (DuplicateCanonicalMapKey "a"))
+        (encodeCanonicalMap [("a", "first"), ("a", "second")])
+
+hex :: ByteString.ByteString -> Text
+hex =
+    Text.pack
+        . concatMap byteHex
+        . ByteString.unpack
+  where
+    byteHex byte =
+        let digits = "0123456789abcdef"
+            high = fromIntegral (byte `div` 16)
+            low = fromIntegral (byte `mod` 16)
+        in [digits `at` high, digits `at` low]
+
+    at characters index =
+        fromMaybe
+            (impossible "hex digit index")
+            (nth index characters)
+
+expectRight :: Show error => Either error value -> IO value
+expectRight = \case
+    Left err ->
+        assertFailure (show err) >> fail "unreachable"
+    Right value ->
+        pure value
+
+withTemporaryDirectory :: String -> (FilePath -> IO a) -> IO a
+withTemporaryDirectory template =
+    bracket create Directory.removePathForcibly
+  where
+    create = do
+        systemTemp <- Directory.getTemporaryDirectory
+        (path, handle) <- openTempFile systemTemp template
+        hClose handle
+        Directory.removeFile path
+        Directory.createDirectory path
+        pure path