heptapod (empty) → 0.2024.8.16

raw patch · 5 files changed

+130/−0 lines, 5 filesdep +basedep +bytestringdep +entropy

Dependencies added: base, bytestring, entropy, time, uuid-types

Files

• CHANGELOG.md +4/−0
• LICENSE.txt +21/−0
• README.md +3/−0
• heptapod.cabal +48/−0
• source/library/Heptapod.hs +54/−0

@@ -0,0 +1,4 @@+# Change log++Heptapod follows the [Package Versioning Policy](https://pvp.haskell.org).+You can find release notes [on GitHub](https://github.com/tfausak/heptapod/releases).

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2024 Taylor Fausak++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,3 @@+# Heptapod++Heptapod is a Haskell library for generating version 7 UUIDs.

@@ -0,0 +1,48 @@+cabal-version: 2.2+category: Data+description: Heptapod generates UUIDv7 values.+extra-doc-files:+  CHANGELOG.md+  README.md++license-file: LICENSE.txt+license: MIT+maintainer: Taylor Fausak+name: heptapod+synopsis: Generate UUIDv7 values.+version: 0.2024.8.16++source-repository head+  location: https://github.com/tfausak/heptapod+  type: git++flag pedantic+  default: False+  manual: True++common library+  build-depends: base ^>=4.18.0.0 || ^>=4.19.0.0 || ^>=4.20.0.0+  default-language: Haskell2010+  ghc-options:+    -Weverything+    -Wno-implicit-prelude+    -Wno-missing-export-lists+    -Wno-missing-safe-haskell-mode+    -Wno-prepositive-qualified-module+    -Wno-safe+    -Wno-unsafe++  if flag(pedantic)+    ghc-options: -Werror++library+  import: library+  build-depends:+    bytestring ^>=0.11.5.3 || ^>=0.12.1.0,+    entropy ^>=0.4.1.10,+    time ^>=1.12.2 || ^>=1.14,+    uuid-types ^>=1.0.6,++  -- cabal-gild: discover source/library+  exposed-modules: Heptapod+  hs-source-dirs: source/library

@@ -0,0 +1,54 @@+-- | This module provides functions for building and generating version 7 UUIDs+-- as defined by section 5.7 of RFC 9562.+--+-- <https://datatracker.ietf.org/doc/html/rfc9562#name-uuid-version-7>+module Heptapod where++import qualified Data.Bits as Bits+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 UUIDv7 using the current time (from 'Time.getSystemTime') and+-- random data (from 'Entropy.getEntropy').+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 = Bits.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 UUIDv7 using the provided fields. Typically you will want to use+-- the 'generate' function instead.+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 =+        Bits.shift+          ( (i64_u64 (Time.systemSeconds t) * 1000)+              + u32_u64 (div (Time.systemNanoseconds t) 1000000)+          )+          16+      ver = Bits.shift 0x7 12 :: Word.Word64+      rand_a = r Bits..&. 0x0fff+      var = Bits.shift 0x2 62 :: Word.Word64+      rand_b = s Bits..&. 0x3fffffffffffffff+   in UUID.fromWords64 (unix_ts_ms + ver + rand_a) (var + rand_b)