-- | 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 :: IO UUID
generate = do
  SystemTime
t <- IO SystemTime
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.
  ByteString
b <- Int -> IO ByteString
Entropy.getEntropy Int
10
  UUID -> IO UUID
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (UUID -> IO UUID) -> UUID -> IO UUID
forall a b. (a -> b) -> a -> b
$
    let u8_u64 :: Word8 -> Word64
u8_u64 = Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word.Word8 -> Word.Word64
        f :: Int -> Int -> Word64
f = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shift (Word64 -> Int -> Word64)
-> (Int -> Word64) -> Int -> Int -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Word64
u8_u64 (Word8 -> Word64) -> (Int -> Word8) -> Int -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => ByteString -> Int -> Word8
ByteString -> Int -> Word8
ByteString.index ByteString
b
        r :: Word64
r = Int -> Int -> Word64
f Int
0 Int
0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
1 Int
8
        s :: Word64
s = Int -> Int -> Word64
f Int
2 Int
0 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
3 Int
8 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
4 Int
16 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
5 Int
24 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
6 Int
32 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
7 Int
40 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
8 Int
48 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Int -> Int -> Word64
f Int
9 Int
56
     in SystemTime -> Word64 -> Word64 -> UUID
build SystemTime
t Word64
r Word64
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 :: SystemTime -> Word64 -> Word64 -> UUID
build SystemTime
t Word64
r Word64
s =
  let i64_u64 :: Int64 -> Word64
i64_u64 = Int64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int.Int64 -> Word.Word64
      u32_u64 :: Word32 -> Word64
u32_u64 = Word32 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word.Word32 -> Word.Word64
      unix_ts_ms :: Word64
unix_ts_ms =
        Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shift
          ( (Int64 -> Word64
i64_u64 (SystemTime -> Int64
Time.systemSeconds SystemTime
t) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000)
              Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word32 -> Word64
u32_u64 (Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
div (SystemTime -> Word32
Time.systemNanoseconds SystemTime
t) Word32
1000000)
          )
          Int
16
      ver :: Word64
ver = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shift Word64
0x7 Int
12 :: Word.Word64
      rand_a :: Word64
rand_a = Word64
r Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
Bits..&. Word64
0x0fff
      var :: Word64
var = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
Bits.shift Word64
0x2 Int
62 :: Word.Word64
      rand_b :: Word64
rand_b = Word64
s Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
Bits..&. Word64
0x3fffffffffffffff
   in Word64 -> Word64 -> UUID
UUID.fromWords64 (Word64
unix_ts_ms Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
ver Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
rand_a) (Word64
var Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
rand_b)