diff --git a/uuid/CHANGES.md b/uuid/CHANGES.md index c3d4615..e8de0a6 100644 --- a/uuid/CHANGES.md +++ b/uuid/CHANGES.md @@ -1,3 +1,7 @@ +1.3.17 + +- Added support for UUIDv7 in `Data.UUID.V7`. + 1.3.16 - Support GHC-8.6.5...9.10.1 diff --git a/uuid/src/Data/UUID/V7.hs b/uuid/src/Data/UUID/V7.hs new file mode 100644 index 0000000..47b60e8 --- /dev/null +++ b/uuid/src/Data/UUID/V7.hs @@ -0,0 +1,70 @@ +-- | +-- Module : Data.UUID.V7 +-- Copyright : (c) Taylor Fausak +-- +-- License : BSD-style +-- +-- Maintainer : aslatter@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- +-- This module implements Version 7 UUIDs as specified +-- in RFC 9562 accessible here: . +-- +-- These UUIDs are partly time-ordered, which improves database locality. + +module Data.UUID.V7 ( generate, build ) where + +import Data.Bits ( (.&.), (.|.), shift ) +import qualified Data.ByteString as ByteString +import qualified Data.Int as Int +import qualified Data.Time.Clock.System as Time +import qualified Data.UUID.Types as UUID +import qualified Data.Word as Word +import qualified System.Entropy as Entropy + +-- | Generates a 'UUID' using the current time (from 'Time.getSystemTime') and +-- random data (from 'Entropy.getEntropy'). +-- +-- @since 1.3.17 +generate :: IO UUID.UUID +generate = do + t <- Time.getSystemTime + -- Note that we only need 74 bits (12 + 62) of randomness. That's a little + -- more than 9 bytes (72 bits), so we have to request 10 bytes (80 bits) of + -- entropy. The extra 6 bits are discarded. + b <- Entropy.getEntropy 10 + pure $ + let u8_u64 = fromIntegral :: Word.Word8 -> Word.Word64 + f = shift . u8_u64 . ByteString.index b + r = f 0 0 + f 1 8 + s = f 2 0 + f 3 8 + f 4 16 + f 5 24 + f 6 32 + f 7 40 + f 8 48 + f 9 56 + in build t r s + +-- | Builds a 'UUID' using the provided fields. Typically you will want to use +-- the 'generate' function instead. +-- +-- @since 1.3.17 +build :: + -- | Corresponds to the @unix_ts_ms@ field. + Time.SystemTime -> + -- | Corresponds to the @rand_a@ field. Only the low 12 bits are used. + Word.Word64 -> + -- | Corresponds to the @rand_b@ field. Only the low 62 bits are used. + Word.Word64 -> + UUID.UUID +build t r s = + let i64_u64 = fromIntegral :: Int.Int64 -> Word.Word64 + u32_u64 = fromIntegral :: Word.Word32 -> Word.Word64 + unix_ts_ms = + shift + ( (i64_u64 (Time.systemSeconds t) * 1000) + + u32_u64 (div (Time.systemNanoseconds t) 1000000) + ) + 16 + ver = shift 0x7 12 :: Word.Word64 + rand_a = r .&. 0x0fff -- 0x0fff = 2^12 - 1 + var = shift 0x2 62 :: Word.Word64 + rand_b = s .&. 0x3fffffffffffffff -- 0x3fffffffffffffff = 2^62 - 1 + in UUID.fromWords64 (unix_ts_ms .|. ver .|. rand_a) (var .|. rand_b) \ No newline at end of file diff --git a/uuid/tests/TestUUID.hs b/uuid/tests/TestUUID.hs index 4650354..64d01ec 100644 --- a/uuid/tests/TestUUID.hs +++ b/uuid/tests/TestUUID.hs @@ -6,11 +6,14 @@ import qualified Data.ByteString.Lazy as BL import Data.Char (ord) import Data.List (nub, (\\)) import Data.Maybe +import qualified Data.Time as Time +import qualified Data.Time.Clock.System as Time import Data.Word import qualified Data.UUID as U import qualified Data.UUID.V1 as U import qualified Data.UUID.V3 as U3 import qualified Data.UUID.V5 as U5 +import qualified Data.UUID.V7 as U7 import Test.QuickCheck ( Arbitrary(arbitrary), choose ) import Test.Tasty ( TestTree, testGroup, defaultMain ) @@ -65,6 +68,32 @@ test_v5 = where name = map (fromIntegral . ord) "www.widgets.com" :: [Word8] uV5 = fromJust $ U.fromString "21f7f8de-8051-5b89-8680-0195ef798b6a" +test_v7 :: Test +test_v7 = testGroup + "version 7" + [ testGroup + "generate" + [ testCase "works" $ do + uuid <- U7.generate + length (U.toString uuid) @?= 36 + ], + testGroup + "build" + [ testCase "works with nil" $ do + let epoch = Time.MkSystemTime 0 0 + let uuid = U7.build epoch 0 0 + U.toString uuid @?= "00000000-0000-7000-8000-000000000000", + testCase "works with test vector" $ do + -- https://datatracker.ietf.org/doc/html/rfc9562#name-example-of-a-uuidv7-value + let time = + Time.utcToSystemTime + . Time.localTimeToUTC (Time.hoursToTimeZone (-5)) + . Time.LocalTime (Time.fromGregorian 2022 2 22) + $ Time.TimeOfDay 14 22 22 + let uuid = U7.build time 0xcc3 0x18C4DC0C0C07398F + U.toString uuid @?= "017f22e2-79b0-7cc3-98c4-dc0c0c07398f" + ] + ] prop_randomsValid :: Test prop_randomsValid = testProperty "Random valid" randomsValid @@ -101,7 +130,8 @@ main = do test_null, test_v1 v1s, test_v3, - test_v5 + test_v5, + test_v7 ] , [ prop_randomsValid, prop_v3NotNull, diff --git a/uuid/uuid.cabal b/uuid/uuid.cabal index 498e492..6469d3c 100644 --- a/uuid/uuid.cabal +++ b/uuid/uuid.cabal @@ -61,6 +61,7 @@ library Data.UUID.V3 Data.UUID.V4 Data.UUID.V5 + Data.UUID.V7 other-modules: Data.UUID.Named @@ -86,6 +87,7 @@ test-suite testuuid base , bytestring , random + , time , uuid -- deps w/o inherited constraints