Split host tests by component ownership

test/Nuthatch/Test/Identity.hs

@@ -0,0 +1,43 @@
+module Nuthatch.Test.Identity
+  ( tests
+  ) where
+
+import           Hedgehog (Property, assert, forAll, property, (===))
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import           Nuthatch.Paths (encodeUserId)
+import           Nuthatch.Types
+import           Test.Tasty (TestTree, testGroup)
+import           Test.Tasty.HUnit ((@?=), testCase)
+import           Test.Tasty.Hedgehog (testProperty)
+
+tests :: TestTree
+tests = testGroup "identities"
+  [ testProperty "root labels parse back to the same root" propRootLabels
+  , testProperty "mutation kind labels parse back to the same kind" propKindLabels
+  , testCase "issuer and subject identity encoding remains stable" $
+      encodeUserId "https://issuer.example" "subject-α"
+        @?= UserId "e0240ab33521a1882fb647a79f7fd3c74c9b6348b29bdb14e572204517882859"
+  , testProperty "issuer and subject inputs are separated" propUserIdentitySeparation
+  ]
+
+propRootLabels :: Property
+propRootLabels = property $ do
+  root <- forAll (Gen.element [Personal, Shared])
+  parseRoot (rootLabel root) === Just root
+
+propKindLabels :: Property
+propKindLabels = property $ do
+  kind <- forAll (Gen.element [Put, Delete])
+  parseKind (kindLabel kind) === Just kind
+
+propUserIdentitySeparation :: Property
+propUserIdentitySeparation = property $ do
+  issuer <- forAll genIdentityPart
+  subject <- forAll genIdentityPart
+  otherIssuer <- forAll (Gen.filter (/= issuer) genIdentityPart)
+  other <- forAll (Gen.filter (/= subject) genIdentityPart)
+  assert (encodeUserId issuer subject /= encodeUserId otherIssuer subject)
+  assert (encodeUserId issuer subject /= encodeUserId issuer other)
+  where
+    genIdentityPart = Gen.text (Range.linear 1 32) Gen.alphaNum