mmzk-typeid 0.6.2.0 → 0.6.3.0

raw patch · 8 files changed

+191/−78 lines, 8 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• README.md +10/−4
• mmzk-typeid.cabal +1/−1
• src/Data/KindID/Class.hs +94/−34
• src/Data/TypeID/Error.hs +20/−14
• src/Data/TypeID/Internal.hs +4/−4
• src/Data/UUID/Versions.hs +0/−2
• test/Spec.hs +43/−19

@@ -1,9 +1,23 @@ # Revision history for mmzk-typeid  +## 0.6.3.0 -- 2024-06-01++* Update implementation so that the prefix for `KindID` now conforms with specification v0.3.0.++* More useful compile-time errors for invalid `KindID` prefixes.++* `TypeIDError` now includes the contextual prefix when necessary to produce better error messages.++* More tests.++* Fix known documentation typos.++ ## 0.6.2.0 -- 2024-05-28  * Fix the bug where the first 32768 `TypeID`s may not of the same timestamp.+ * Test on GHC 9.8.2.  @@ -11,7 +25,9 @@  * Fix typo in the maintainer's email address.   * Astounded at the fact that I mismatched the local part and domain name and didn't realise it for a year.+ * More test cases on parsing.+ * Fix other typos and inconsistencies in the documentation.  @@ -21,6 +37,7 @@   * Allow `TypeID` prefix to contain underscores.   * Update parsing logic as well as `Binary` and `Storable` instances to reflect the changes.   * Add tests.+ * Have a breaking change in `TypeIDError` to better reflect the error cases for the update in the specification.  @@ -136,6 +153,8 @@ * Remove dependency on 'transformers'.  * Fix typos in the documentation.++* Update README examples.  * More tests. 

@@ -21,7 +21,7 @@ In addition to the features provided by [TypeID](https://github.com/jetpack-io/typeid), this implementation also supports:  1. Generating TypeIDs in a batch. They are guaranteed to have the same timestamp (up to the first 32768 ids) and of ascending order;-2. Encoding the prefix in the [type level](https://hackage.haskell.org/package/mmzk-typeid/docs/Data-KindID.html), so that if you accidentally pass in a wrong prefix, the code won't compile, avoiding the need for runtime checks;+2. Encoding the prefix in the [type level](https://hackage.haskell.org/package/mmzk-typeid/docs/Data-KindID.html), so that if you accidentally pass in an invalid prefix, the code won't compile, avoiding the need for runtime checks; 3. Support TypeID with other UUID versions. Currently v7 (default), v1,  v4, and v5 are supported.  ## Quick start@@ -157,6 +157,7 @@  main :: IO () main = do+   -- Make a TypeID with prefix 'mmzk':   typeID <- genID @TypeID "mmzk"   print typeID@@ -174,6 +175,11 @@   case string2ID "mmzk_01h455vb4pex5vsknk084sn02q" :: Maybe (KindID "mmzk") of     Left err     -> throwIO err     Right kindID -> print kindID++  -- Parse a KindID from string (wrong prefix):+  case string2ID "mmzk_01h455vb4pex5vsknk084sn02q" :: Maybe (KindID "foo") of+    Left err     -> throwIO err -- Will throw here as the prefix matches not+    Right kindID -> print kindID ```  We no longer need to use qualified imports, but on the down side, we need to add explicit type annotations. Therefore it is a matter of preference.@@ -214,13 +220,13 @@ main :: IO () main = do   -- ...-  userID <- genKindID @'User -- Same as genKindID @"user"-  postID <- genKindID @'Post -- Same as genKindID @"post"+  userID    <- genKindID @'User -- Same as genKindID @"user"+  postID    <- genKindID @'Post -- Same as genKindID @"post"   commentID <- genKindID @'Comment -- Same as genKindID @"comment"   -- ... ``` -For more information, see [Data.KindID.Class]([src/Data/KindID/Class.hs](https://hackage.haskell.org/package/mmzk-typeid/docs/Data-KindID-Class.html)).+For more information, see [Data.KindID.Class](https://hackage.haskell.org/package/mmzk-typeid/docs/Data-KindID-Class.html).  ## Note Functions not explicitly exported are considered internal and are subjected to changes.

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               mmzk-typeid-version:            0.6.2.0+version:            0.6.3.0  synopsis:           A TypeID and UUIDv7 implementation for Haskell description:

@@ -15,45 +15,26 @@     ValidPrefix   , ToPrefix(..)   -- * Helpers+  , LengthLT64C+  , IsLUSymbolC   , LengthSymbol-  , IsLowerSymbol   , IsLowerChar+  , IsUnderscore+  , IsLUSymbol+  , ILUSUH1+  , ILUSUH2+  -- * Deprecated Helpers+  , IsLowerSymbol   , LSUH   , ILSUH   ) where +import           Data.Kind import           Data.Type.Bool import           Data.Type.Equality import           Data.Type.Ord import           GHC.TypeLits --- | A constraint for valid prefix 'Symbol's.-type ValidPrefix prefix = ( KnownSymbol prefix-                          , LengthSymbol prefix < 64-                          , IsLowerSymbol prefix ~ 'True )---- | The length of a 'Symbol' as a 'Nat'.-type family LengthSymbol (prefix :: Symbol) :: Nat where-  LengthSymbol prefix = LSUH (UnconsSymbol prefix)---- | Length Symbol Uncons Helper.-type family LSUH (uncons :: Maybe (Char, Symbol)) :: Nat where-  LSUH 'Nothing        = 0-  LSUH ('Just '(c, s)) = 1 + LengthSymbol s---- | Is a type-level 'Char' lower case?-type family IsLowerChar (ch :: Char) :: Bool where-  IsLowerChar ch = Compare '`' ch == 'LT && Compare ch '{' == 'LT---- | Is a 'Symbol' lower case?-type family IsLowerSymbol (prefix :: Symbol) :: Bool where-  IsLowerSymbol prefix = ILSUH (UnconsSymbol prefix)---- | Is Lower Symbol Uncons Helper.-type family ILSUH (uncons :: Maybe (Char, Symbol)) :: Bool where-  ILSUH 'Nothing        = 'True-  ILSUH ('Just '(c, s)) = IsLowerChar c && IsLowerSymbol s- -- | A class that translates any kind to a 'Symbol'. It is used to translate -- custom data kinds to a 'Symbol' so that they can be used as -- 'Data.KindID.KindID' prefixes.@@ -61,7 +42,7 @@ -- For example, suppose we have the following data structure that represents the -- prefixes we are going to use: ----- > data Prefix = User | Post | Comment+-- > data Prefix = User | Post | Comment | SuperUser -- -- Then we can make it an instance of 'ToPrefix' like this: --@@ -73,16 +54,95 @@ -- > -- > instance ToPrefix 'Comment where -- >   type PrefixSymbol 'Comment = "comment"+-- >+-- > instance ToPrefix 'SuperUser where+-- >   type PrefixSymbol 'SuperUser = "super_user" -- -- Now we can use Prefix as a prefix for 'Data.KindID.KindID's, e.g. -- -- > do--- >   userID <- genKindID @'User -- Same as genKindID @"user"--- >   postID <- genKindID @'Post -- Same as genKindID @"post"--- >   commentID <- genKindID @'Comment -- Same as genKindID @"comment"+-- >   userID    <- genKindID @'User      -- Same as genKindID @"user"+-- >   postID    <- genKindID @'Post      -- Same as genKindID @"post"+-- >   commentID <- genKindID @'Comment   -- Same as genKindID @"comment"+-- >   suID      <- genKindID @'SuperUser -- Same as genKindID @"super_user" class ToPrefix a where   type PrefixSymbol a :: Symbol  -- | The 'PrefixSymbol' of a 'Symbol' is the 'Symbol' itself.-instance ToPrefix (a :: Symbol) where-  type PrefixSymbol a = a+instance ToPrefix (s :: Symbol) where+  type PrefixSymbol s = s++-- | A constraint for valid prefix 'Symbol's.+type ValidPrefix prefix = ( KnownSymbol prefix+                          , LengthLT64C prefix+                          , IsLUSymbolC prefix )++-- | Contains a custom error message if the prefix 'Symbol' is too long.+type family LengthLT64C (prefix :: Symbol) :: Constraint where+  LengthLT64C s+    = If (Compare (LengthSymbol s) 64 == 'LT) (() :: Constraint)+         ( TypeError ( Text "The prefix "+                  :<>: ShowType s+                  :<>: Text " with "+                  :<>: ShowType (LengthSymbol s)+                  :<>: Text " characters is too long!" ) )++-- | Contains a custom error message if the prefix 'Symbol' is not lowercase ++-- underscore or it starts or ends with underscores.+type family IsLUSymbolC (prefix :: Symbol) :: Constraint where+  IsLUSymbolC s+    = If (IsLUSymbol s) (() :: Constraint)+         ( TypeError ( Text "The prefix "+                  :<>: ShowType s+                  :<>: Text " is not valid!" ) )++-- | The length of a 'Symbol' as a 'Nat'.+type family LengthSymbol (prefix :: Symbol) :: Nat where+  LengthSymbol prefix = LSUH (UnconsSymbol prefix)++-- | LengthSymbol Uncons Helper.+type family LSUH (uncons :: Maybe (Char, Symbol)) :: Nat where+  LSUH 'Nothing          = 0+  LSUH ('Just '( c, s )) = 1 + LengthSymbol s++-- | Is a type-level 'Char' lowercase?+type family IsLowerChar (ch :: Char) :: Bool where+  IsLowerChar ch = Compare '`' ch == 'LT && Compare ch '{' == 'LT++-- | Is a type-level 'Char' an underscore?+type family IsUnderscore (ch :: Char) :: Bool where+  IsUnderscore ch = Compare '_' ch == 'EQ++-- | Is a 'Symbol' lowercase + underscore and not start or end with underscores?+type family IsLUSymbol (prefix :: Symbol) :: Bool where+  IsLUSymbol prefix = ILUSUH1 (UnconsSymbol prefix)++-- | First IsLUSymbol Uncons Helper.+type family ILUSUH1 (uncons :: Maybe (Char, Symbol)) :: Bool where+  ILUSUH1 'Nothing            = True+  ILUSUH1 ('Just '( '_', _ )) = False+  ILUSUH1 ('Just '( c, s ))   = (IsLowerChar c || IsUnderscore c)+                             && ILUSUH2 (UnconsSymbol s)++-- | Second IsLUSymbol Uncons Helper.+type family ILUSUH2 (uncons :: Maybe (Char, Symbol)) :: Bool where+  ILUSUH2 'Nothing           = True+  ILUSUH2 ('Just '( c, "" )) = IsLowerChar c+  ILUSUH2 ('Just '( c, s ))  = (IsLowerChar c || IsUnderscore c)+                            && ILUSUH2 (UnconsSymbol s)+++--------------------------------------------------------------------------------+-- Deprecated+--------------------------------------------------------------------------------++-- | Is a 'Symbol' lowercase?+type family IsLowerSymbol (prefix :: Symbol) :: Bool where+  IsLowerSymbol prefix = ILSUH (UnconsSymbol prefix)+{-# DEPRECATED IsLowerSymbol "No longer used; to be removed in version 0.7" #-}++-- | Is LowerSymbol Uncons Helper.+type family ILSUH (uncons :: Maybe (Char, Symbol)) :: Bool where+  ILSUH 'Nothing          = 'True+  ILSUH ('Just '( c, s )) = IsLowerChar c && IsLowerSymbol s+{-# DEPRECATED ILSUH "No longer used; to be removed in the version 0.7" #-}

@@ -14,20 +14,24 @@  import           Control.Exception import           Data.Text (Text)+import qualified Data.Text as T  -- | Errors from parsing TypeIDs.+--+-- Should NOT rely on \"grepping\" the output produced by 'show' since the+-- exact output format may differ across library versions. data TypeIDError-  = -- | The prefix longer than 63 characters.-    TypeIDErrorPrefixTooLong Int+  = -- | The prefix is longer than 63 characters.+    TypeIDErrorPrefixTooLong Text     -- | The ID contains an extra underscore separator.   | TypeIDExtraSeparator     -- | The ID starts with an underscore separator.-  | TypeIDStartWithUnderscore+  | TypeIDStartWithUnderscore Text     -- | The ID ends with an underscore separator.-  | TypeIDEndWithUnderscore+  | TypeIDEndWithUnderscore Text     -- | The prefix contains an invalid character, namely not lowercase Latin.-  | TypeIDErrorPrefixInvalidChar Char-    -- | From a `Data.KindID.KindID` conversion. The prefix doesn't match with+  | TypeIDErrorPrefixInvalidChar Text Char+    -- | From a 'Data.KindID.V7KindID' conversion. The prefix doesn't match with     -- the expected.   | TypeIDErrorPrefixMismatch Text Text     -- | The 'Data.UUID.Types.Internal.UUID' suffix has errors.@@ -36,16 +40,18 @@  instance Show TypeIDError where   show :: TypeIDError -> String-  show (TypeIDErrorPrefixTooLong n)-    = concat ["Prefix with ", show n, " characters is too long!"]+  show (TypeIDErrorPrefixTooLong txt)+    = concat [ "The prefix ", show txt+             , " with ", show (T.length txt), " characters is too long!" ]   show TypeIDExtraSeparator     = "The underscore separator should not be present if the prefix is empty!"-  show TypeIDStartWithUnderscore-    = "The prefix should not start with an underscore!"-  show TypeIDEndWithUnderscore-    = "The prefix should not end with an underscore!"-  show (TypeIDErrorPrefixInvalidChar c)-    = concat ["Prefix contains invalid character ", show c, "!"]+  show (TypeIDStartWithUnderscore txt)+    = concat ["The prefix ", show txt, " should not start with an underscore!"]+  show (TypeIDEndWithUnderscore txt)+    = concat ["The prefix ", show txt, " should not end with an underscore!"]+  show (TypeIDErrorPrefixInvalidChar txt c)+    = concat [ "The prefix ", show txt+             , " contains invalid character ", show c, "!"]   show (TypeIDErrorPrefixMismatch expPrefix actPrefix)     = concat [ "Expected prefix ", show expPrefix, " but got "              , show actPrefix, "!" ]

@@ -543,16 +543,16 @@ -- | Check if the given prefix is a valid 'TypeID'' prefix. checkPrefix :: Text -> Maybe TypeIDError checkPrefix prefix-  | T.length prefix > 63 = Just $ TypeIDErrorPrefixTooLong (T.length prefix)+  | T.length prefix > 63 = Just $ TypeIDErrorPrefixTooLong prefix   | T.null prefix        = Nothing-  | T.head prefix == '_' = Just TypeIDStartWithUnderscore-  | T.last prefix == '_' = Just TypeIDEndWithUnderscore+  | T.head prefix == '_' = Just $ TypeIDStartWithUnderscore prefix+  | T.last prefix == '_' = Just $ TypeIDEndWithUnderscore prefix   | otherwise       = case T.uncons ( T.dropWhile ( liftM2 (||) (== '_')                                     $ liftM2 (&&) isLower isAscii)                         prefix) of         Nothing     -> Nothing-        Just (c, _) -> Just $ TypeIDErrorPrefixInvalidChar c+        Just (c, _) -> Just $ TypeIDErrorPrefixInvalidChar prefix c {-# INLINE checkPrefix #-}  -- | Check if the prefix is valid and the suffix 'UUID' has the correct v7

@@ -19,8 +19,6 @@  -- | The supported 'UUID' versions. These constructors are used as type-level -- tags for 'Data.TypeID.TypeID''.------ 'V5' is not supported yet. data UUIDVersion = V1 | V4 | V5 | V7   deriving (Eq, Ord, Bounded, Enum, Show) 

@@ -1,7 +1,10 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-}  {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+#if __GLASGOW_HASKELL__ >= 908 {-# OPTIONS_GHC -Wno-x-partial #-}+#endif  import           Control.Monad import           Data.Aeson@@ -30,6 +33,7 @@ import           Data.UUID.V4 (nextRandom) import           Data.UUID.V7 (UUID) import qualified Data.UUID.V7 as V7+import           Data.UUID.Versions import           Foreign import           GHC.Generics (Generic) import           Test.Hspec@@ -46,7 +50,7 @@                                      , uuid   :: UUID }   deriving (Generic, FromJSON, ToJSON) -data Prefix = User | Post | Comment+data Prefix = User | Post | SuperUser  instance ToPrefix 'User where   type PrefixSymbol 'User = "user"@@ -54,8 +58,8 @@ instance ToPrefix 'Post where   type PrefixSymbol 'Post = "post" -instance ToPrefix 'Comment where-  type PrefixSymbol 'Comment = "comment"+instance ToPrefix 'SuperUser where+  type PrefixSymbol 'SuperUser = "super_user"  anyTypeIDError :: Selector TypeIDError anyTypeIDError = const True@@ -95,16 +99,19 @@       start <- V7.getEpochMilli       tid   <- withCheck $ genID @TypeID "mmzk"       getPrefix tid `shouldBe` "mmzk"+      validateWithVersion (getUUID tid) V7 `shouldBe` True       getTime tid `shouldSatisfy` \t -> t >= start     it "can generate TypeID without prefix" do       start <- V7.getEpochMilli       tid   <- withCheck $ genID @TypeID ""       getPrefix tid `shouldBe` ""+      validateWithVersion (getUUID tid) V7 `shouldBe` True       getTime tid `shouldSatisfy` \t -> t >= start     it "can generate TypeID with stateless UUIDv7" do       start <- V7.getEpochMilli       tid   <- withCheck $ genID' @TypeID "mmzk"       getPrefix tid `shouldBe` "mmzk"+      validateWithVersion (getUUID tid) V7 `shouldBe` True       getTime tid `shouldSatisfy` \t -> t >= start     it "can generate in batch with same timestamp and in ascending order" do       start <- V7.getEpochMilli@@ -112,6 +119,7 @@       all ((== "mmzk") . getPrefix) tids `shouldBe` True       let timestamp = getTime $ head tids       all ((== timestamp) . getTime) tids `shouldBe` True+      all (\tid -> validateWithVersion (getUUID tid) V7) tids `shouldBe` True       all (uncurry (<)) (zip tids $ tail tids) `shouldBe` True       timestamp `shouldSatisfy` \t -> t >= start     it "can parse TypeID from String" do@@ -228,16 +236,19 @@       start <- V7.getEpochMilli       kid   <- withCheck $ genID @(KindID "mmzk")       getPrefix kid `shouldBe` "mmzk"+      validateWithVersion (getUUID kid) V7 `shouldBe` True       getTime kid `shouldSatisfy` \t -> start <= t     it "can generate KindID without prefix" do       start <- V7.getEpochMilli       kid   <- withCheck $ genID @(KindID "")       getPrefix kid `shouldBe` ""+      validateWithVersion (getUUID kid) V7 `shouldBe` True       getTime kid `shouldSatisfy` \t -> start <= t     it "can generate KindID with stateless UUIDv7" do       start <- V7.getEpochMilli       kid   <- withCheck $ genID' @(KindID "mmzk")       getPrefix kid `shouldBe` "mmzk"+      validateWithVersion (getUUID kid) V7 `shouldBe` True       getTime kid `shouldSatisfy` \t -> start <= t     it "can generate in batch with same timestamp and in ascending order" do       start <- V7.getEpochMilli@@ -245,6 +256,7 @@       all ((== "mmzk") . getPrefix) kids `shouldBe` True       let timestamp = getTime $ head kids       all ((== timestamp) . getTime) kids `shouldBe` True+      all (\kid -> validateWithVersion (getUUID kid) V7) kids `shouldBe` True       all (uncurry (<)) (zip kids $ tail kids) `shouldBe` True       timestamp `shouldSatisfy` \t -> start <= t     it "can parse KindID from String" do@@ -261,16 +273,16 @@         kid <- withCheck $ genID @(KindID 'Post)         getPrefix kid `shouldBe` "post"     it "can parse KindID from String" do-      case string2ID @(KindID 'User) "user_00041061050r3gg28a1c60t3gf" of+      case string2ID @(KindID 'SuperUser) "super_user_00041061050r3gg28a1c60t3gf" of         Left err  -> expectationFailure $ "Parse error: " ++ show err-        Right kid -> getPrefix kid `shouldBe` "user"+        Right kid -> getPrefix kid `shouldBe` "super_user"     it "cannot parse KindID into wrong prefix" do-      case string2ID @(KindID 'Comment) "user_00041061050r3gg28a1c60t3gf" of+      case string2ID @(KindID 'User) "super_user_00041061050r3gg28a1c60t3gf" of         Left _    -> pure ()         Right kid -> expectationFailure $ "Parsed KindID: " ++ show kid     it "can generate in batch with same timestamp and in ascending order" do-      kids <- withChecks $ genIDs @(KindID 'Comment) 32768-      all ((== "comment") . getPrefix) kids `shouldBe` True+      kids <- withChecks $ genIDs @(KindID 'User) 32768+      all ((== "user") . getPrefix) kids `shouldBe` True       let timestamp = getTime $ head kids       all ((== timestamp) . getTime) kids `shouldBe` True       all (uncurry (<)) (zip kids $ tail kids) `shouldBe` True@@ -323,9 +335,11 @@     it "can generate TypeIDV1 without prefix" do       tid <- withCheck $ genID @TypeIDV1 ""       getPrefix tid `shouldBe` ""+      validateWithVersion (getUUID tid) V1 `shouldBe` True     it "can generate TypeIDV1 with insecure UUIDv4" do       tid   <- withCheck $ genID' @TypeIDV1 "mmzk"       getPrefix tid `shouldBe` "mmzk"+      validateWithVersion (getUUID tid) V1 `shouldBe` True     it "can parse TypeIDV1 from String" do       case string2ID @TypeIDV1 "mmzk_5hjpeh96458fct8t49fnf9farw" of         Left err  -> expectationFailure $ "Parse error: " ++ show err@@ -439,9 +453,11 @@     it "can generate KindIDV1 with prefix" do       kid <- withCheck $ genID @(KindIDV1 "mmzk")       getPrefix kid `shouldBe` "mmzk"+      validateWithVersion (getUUID kid) V1 `shouldBe` True     it "can generate KindIDV1 without prefix" do       kid <- withCheck $ genID @(KindIDV1 "")       getPrefix kid `shouldBe` ""+      validateWithVersion (getUUID kid) V1 `shouldBe` True     it "can parse KindID from String" do       case string2ID @(KindIDV1 "mmzk") "mmzk_5hjpeh96458fct8t49fnf9farw" of         Left err  -> expectationFailure $ "Parse error: " ++ show err@@ -456,11 +472,11 @@         kid <- withCheck $ genID @(KindID 'Post)         getPrefix kid `shouldBe` "post"     it "can parse KindIDV1 from String" do-      case string2ID @(KindIDV1 'User) "user_00041061050r3gg28a1c60t3gf" of+      case string2ID @(KindIDV1 'SuperUser) "super_user_00041061050r3gg28a1c60t3gf" of         Left err  -> expectationFailure $ "Parse error: " ++ show err-        Right kid -> getPrefix kid `shouldBe` "user"+        Right kid -> getPrefix kid `shouldBe` "super_user"     it "cannot parse KindIDV1 into wrong prefix" do-      case string2ID @(KindIDV1 'Comment) "user_00041061050r3gg28a1c60t3gf" of+      case string2ID @(KindIDV1 'User) "post_00041061050r3gg28a1c60t3gf" of         Left _    -> pure ()         Right kid -> expectationFailure $ "Parsed KindIDV1: " ++ show kid @@ -509,9 +525,11 @@     it "can generate TypeIDV4 with prefix" do       tid <- withCheck $ genID @TypeIDV4 "mmzk"       getPrefix tid `shouldBe` "mmzk"+      validateWithVersion (getUUID tid) V4 `shouldBe` True     it "can generate TypeIDV4 without prefix" do       tid <- withCheck $ genID @TypeIDV4 ""       getPrefix tid `shouldBe` ""+      validateWithVersion (getUUID tid) V4 `shouldBe` True     it "can generate TypeIDV4 with insecure UUIDv4" do       tid   <- withCheck $ genID' @TypeIDV4 "mmzk"       getPrefix tid `shouldBe` "mmzk"@@ -628,9 +646,11 @@     it "can generate KindIDV4 with prefix" do       kid <- withCheck $ genID @(KindIDV4 "mmzk")       getPrefix kid `shouldBe` "mmzk"+      validateWithVersion (getUUID kid) V4 `shouldBe` True     it "can generate KindIDV4 without prefix" do       kid <- withCheck $ genID @(KindIDV4 "")       getPrefix kid `shouldBe` ""+      validateWithVersion (getUUID kid) V4 `shouldBe` True     it "can generate KindIDV4 with insecure UUIDv4" do       kid <- withCheck $ genID' @(KindIDV4 "mmzk")       getPrefix kid `shouldBe` "mmzk"@@ -648,11 +668,11 @@         kid <- withCheck $ genID @(KindID 'Post)         getPrefix kid `shouldBe` "post"     it "can parse KindIDV4 from String" do-      case string2ID @(KindIDV4 'User) "user_00041061050r3gg28a1c60t3gf" of+      case string2ID @(KindIDV4 'SuperUser) "super_user_00041061050r3gg28a1c60t3gf" of         Left err  -> expectationFailure $ "Parse error: " ++ show err-        Right kid -> getPrefix kid `shouldBe` "user"+        Right kid -> getPrefix kid `shouldBe` "super_user"     it "cannot parse KindIDV4 into wrong prefix" do-      case string2ID @(KindIDV4 'Comment) "user_00041061050r3gg28a1c60t3gf" of+      case string2ID @(KindIDV4 'User) "post_00041061050r3gg28a1c60t3gf" of         Left _    -> pure ()         Right kid -> expectationFailure $ "Parsed KindIDV4: " ++ show kid @@ -703,19 +723,21 @@     it "can generate TypeIDV5 with prefix" do       tid <- withCheck $ genID @TypeIDV5 "mmzk" uid [11, 45, 14]       getPrefix tid `shouldBe` "mmzk"+      validateWithVersion (getUUID tid) V5 `shouldBe` True     it "can generate TypeIDV5 without prefix" do       tid <- withCheck $ genID @TypeIDV5 "" uid [11, 45, 14]       getPrefix tid `shouldBe` ""+      validateWithVersion (getUUID tid) V5 `shouldBe` True     it "can parse TypeIDV5 from String" do       case string2ID @TypeIDV5 "mmzk_5hjpeh96458fct8t49fnf9farw" of         Left err  -> expectationFailure $ "Parse error: " ++ show err         Right tid -> getPrefix tid `shouldBe` "mmzk"     it "can parse TypeIDV5 from Text" do-      case text2ID @TypeID "mmzk_00041061050r3gg28a1c60t3gf" of+      case text2ID @TypeIDV5 "mmzk_00041061050r3gg28a1c60t3gf" of         Left err  -> expectationFailure $ "Parse error: " ++ show err         Right tid -> getPrefix tid `shouldBe` "mmzk"     it "can parse TypeIDV5 from ByteString" do-      case byteString2ID @TypeID "mmzk_00041061050r3gg28a1c60t3gf" of+      case byteString2ID @TypeIDV5 "mmzk_00041061050r3gg28a1c60t3gf" of         Left err  -> expectationFailure $ "Parse error: " ++ show err         Right tid -> getPrefix tid `shouldBe` "mmzk" @@ -822,9 +844,11 @@     it "can generate KindIDV5 with prefix" do       kid <- withCheck $ genID @(KindIDV5 "mmzk") uid [11, 45, 14]       getPrefix kid `shouldBe` "mmzk"+      validateWithVersion (getUUID kid) V5 `shouldBe` True     it "can generate KindIDV5 without prefix" do       kid <- withCheck $ genID @(KindIDV5 "") uid [11, 45, 14]       getPrefix kid `shouldBe` ""+      validateWithVersion (getUUID kid) V5 `shouldBe` True     it "can parse KindID from String" do       case string2ID @(KindIDV5 "mmzk") "mmzk_5hjpeh96458fct8t49fnf9farw" of         Left err  -> expectationFailure $ "Parse error: " ++ show err@@ -839,11 +863,11 @@         kid <- withCheck $ genID @(KindID 'Post)         getPrefix kid `shouldBe` "post"     it "can parse KindIDV5 from String" do-      case string2ID @(KindIDV5 'User) "user_00041061050r3gg28a1c60t3gf" of+      case string2ID @(KindIDV5 'SuperUser) "super_user_00041061050r3gg28a1c60t3gf" of         Left err  -> expectationFailure $ "Parse error: " ++ show err-        Right kid -> getPrefix kid `shouldBe` "user"+        Right kid -> getPrefix kid `shouldBe` "super_user"     it "cannot parse KindIDV5 into wrong prefix" do-      case string2ID @(KindIDV5 'Comment) "user_00041061050r3gg28a1c60t3gf" of+      case string2ID @(KindIDV5 'User) "post_00041061050r3gg28a1c60t3gf" of         Left _    -> pure ()         Right kid -> expectationFailure $ "Parsed KindIDV5: " ++ show kid