mmzk-typeid 0.6.0.1 → 0.6.2.0
raw patch · 4 files changed
+52/−39 lines, 4 filesdep ~text
Dependency ranges changed: text
Files
- CHANGELOG.md +6/−0
- mmzk-typeid.cabal +5/−4
- src/Data/UUID/V7.hs +37/−32
- test/Spec.hs +4/−3
CHANGELOG.md view
@@ -1,6 +1,12 @@ # Revision history for mmzk-typeid +## 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.++ ## 0.6.0.1 -- 2024-04-26 * Fix typo in the maintainer's email address.
mmzk-typeid.cabal view
@@ -1,8 +1,8 @@ cabal-version: 2.4 name: mmzk-typeid-version: 0.6.0.1+version: 0.6.2.0 -synopsis: A TypeID implementation for Haskell+synopsis: A TypeID and UUIDv7 implementation for Haskell description: 'TypeID' is a type-safe, K-sortable, globally unique identifier inspired by Stripe IDs. .@@ -33,10 +33,11 @@ license: MIT author: Yitang Chen <mmzk1526@outlook.com> maintainer: Yitang Chen <mmzk1526@outlook.com>-category: Data, UUID, TypeID+category: Data, UUID, UUIDv7, TypeID tested-with: GHC == 9.2.8 GHC == 9.6.1+ GHC == 9.8.2 extra-source-files: CHANGELOG.md LICENSE@@ -102,7 +103,7 @@ entropy ^>=0.4, hashable ^>=1.4, random ^>=1.2,- text ^>=2.0,+ text ^>=2.1, time >=1.11 && <1.13, uuid ^>=1.3, uuid-types ^>=1.0,
src/Data/UUID/V7.hs view
@@ -76,38 +76,43 @@ -- It is guaranteed that the first 32768 'UUID's are generated at the same -- timestamp. genUUIDs :: MonadIO m => Word16 -> m [UUID]-genUUIDs 0 = pure []-genUUIDs n = liftIO do- timestamp <- getEpochMilli- -- We set the first bit of the entropy to 0 to ensure that there's enough- -- room for incrementing the sequence number.- entropy16 <- (.&. 0x7FFF) <$> getEntropyWord16- -- Calculate the maximum number of slots we can use for the current timestamp- -- before the sequence number overflows.- let getMaxSlots num seqNo = if 0xFFFF - seqNo < num- then (0xFFFF - seqNo, 0xFFFF)- else (num, seqNo + num)- -- Get the sequence number corresponding to the current timestamp and the- -- number of UUIDs we can generate.- (n', seqNo) <- atomicModifyIORef __state__ $ \(ts, seqNo) -> if- | ts < timestamp -> let (n', entropy16') = getMaxSlots n entropy16- in ((timestamp, entropy16'), (n', entropy16 + 1))- | ts > timestamp -> ((ts, seqNo), (0, 0))- | otherwise -> let (n', entropy16') = getMaxSlots n seqNo- in ((timestamp, entropy16'), (n', seqNo + 1))- -- If we can't generate any UUIDs, we try again, hoping that the timestamp- -- has changed.- if n' == 0- then genUUIDs n- else do- uuids <- forM [0..(n' - 1)] $ \curN -> do- entropy64 <- getEntropyWord64- let bs = runPut do- fillTime timestamp- fillVerAndRandA (seqNo + curN)- fillVarAndRandB (seqNo + curN) entropy64- pure . uncurry UUID $ runGet (join (liftM2 (,)) getWord64be) bs- if n' == n then pure uuids else (uuids ++) <$> genUUIDs (n - n')+genUUIDs = liftIO . go True+ where+ go _ 0 = pure []+ go mustSameTime n = do+ timestamp <- getEpochMilli+ -- We set the first bit of the entropy to 0 to ensure that there's enough+ -- room for incrementing the sequence number.+ entropy16 <- (.&. 0x7FFF) <$> getEntropyWord16+ -- Calculate the maximum number of slots we can use for the current+ -- timestamp before the sequence number overflows.+ let getMaxSlots num seqNo = if 0xFFFF - seqNo < num+ then ( if mustSameTime && num <= 32768 then 0 else 0xFFFF - seqNo+ , 0xFFFF )+ else (num, seqNo + num)+ -- Get the sequence number corresponding to the current timestamp and the+ -- number of UUIDs we can generate.+ (n', seqNo) <- atomicModifyIORef __state__ \(ts, seqNo) -> if+ | ts < timestamp -> let (n', entropy16') = getMaxSlots n entropy16+ in ((timestamp, entropy16'), (n', entropy16 + 1))+ | ts > timestamp -> ((ts, seqNo), (0, 0))+ | otherwise -> let (n', entropy16') = getMaxSlots n seqNo+ in ((timestamp, entropy16'), (n', seqNo + 1))+ -- If we can't generate any UUIDs, we try again, hoping that the timestamp+ -- has changed.+ if n' == 0+ then go mustSameTime n+ else do+ uuids <- forM [0..(n' - 1)] $ \curN -> do+ entropy64 <- getEntropyWord64+ let bs = runPut do+ fillTime timestamp+ fillVerAndRandA (seqNo + curN)+ fillVarAndRandB (seqNo + curN) entropy64+ pure . uncurry UUID $ runGet (join (liftM2 (,)) getWord64be) bs+ if n' == n+ then pure uuids+ else (uuids ++) <$> go False (n - n') -- | Validate the version and variant of the 'UUID'v7. validate :: UUID -> Bool
test/Spec.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}+{-# OPTIONS_GHC -Wno-x-partial #-} import Control.Monad import Data.Aeson@@ -107,7 +108,7 @@ getTime tid `shouldSatisfy` \t -> t >= start it "can generate in batch with same timestamp and in ascending order" do start <- V7.getEpochMilli- tids <- withChecks $ genIDs @TypeID "mmzk" 1526+ tids <- withChecks $ genIDs @TypeID "mmzk" 32768 all ((== "mmzk") . getPrefix) tids `shouldBe` True let timestamp = getTime $ head tids all ((== timestamp) . getTime) tids `shouldBe` True@@ -240,7 +241,7 @@ getTime kid `shouldSatisfy` \t -> start <= t it "can generate in batch with same timestamp and in ascending order" do start <- V7.getEpochMilli- kids <- withChecks $ genIDs @(KindID "mmzk") 1526+ kids <- withChecks $ genIDs @(KindID "mmzk") 32768 all ((== "mmzk") . getPrefix) kids `shouldBe` True let timestamp = getTime $ head kids all ((== timestamp) . getTime) kids `shouldBe` True@@ -268,7 +269,7 @@ 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) 1526+ kids <- withChecks $ genIDs @(KindID 'Comment) 32768 all ((== "comment") . getPrefix) kids `shouldBe` True let timestamp = getTime $ head kids all ((== timestamp) . getTime) kids `shouldBe` True