module Data.UUID.Extras
    ( isValidVersion
    , mockUUIDs
    , mockUUIDToSequenceId
    , sequenceIdToMockUUID
    ) where

import Data.Bits (shiftL, (.&.))
import Data.ByteString.Lazy qualified as BL
import Data.UUID (UUID)
import Data.UUID qualified as UUID
import Data.Word (Word32)

-- This is taken directly from the test suite of
-- 'uuid:Data.UUID'. Strange that they don't include it in the core
-- library.
isValidVersion :: Int -> UUID -> Bool
isValidVersion :: Int -> UUID -> Bool
isValidVersion Int
v UUID
u = Bool
lenOK Bool -> Bool -> Bool
&& Bool
variantOK Bool -> Bool -> Bool
&& Bool
versionOK
  where
    bs :: ByteString
bs = UUID -> ByteString
UUID.toByteString UUID
u
    lenOK :: Bool
lenOK = ByteString -> Int64
BL.length ByteString
bs Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
16
    variantOK :: Bool
variantOK = (ByteString -> Int64 -> Word8
BL.index ByteString
bs Int64
8) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xc0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x80
    versionOK :: Bool
versionOK = (ByteString -> Int64 -> Word8
BL.index ByteString
bs Int64
6) Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
.&. Word8
0xf0 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
v Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
4)

-- | Given a UUID from 'mockUUIDs`, returns a simple sequence
-- number. Returns 'Nothing' if your UUID doesn't seem to come from
-- that sequence. As the name suggests, you should really only be
-- using this for mocking/testing.
mockUUIDToSequenceId :: UUID -> Maybe Word32
mockUUIDToSequenceId :: UUID -> Maybe Word32
mockUUIDToSequenceId UUID
uuid =
    case UUID -> (Word32, Word32, Word32, Word32)
UUID.toWords UUID
uuid of
        (Word32
0, Word32
0x4000, Word32
0x80000000, Word32
x) -> Word32 -> Maybe Word32
forall a. a -> Maybe a
Just Word32
x
        (Word32, Word32, Word32, Word32)
_                          -> Maybe Word32
forall a. Maybe a
Nothing

-- | Create a UUID that can be used in testing, from a simple 'Word32'.
-- Reminder: Use 'fromIntegral i' to call it with an 'Int'.
sequenceIdToMockUUID :: Word32 -> UUID
sequenceIdToMockUUID :: Word32 -> UUID
sequenceIdToMockUUID = Word32 -> Word32 -> Word32 -> Word32 -> UUID
UUID.fromWords Word32
0 Word32
0x4000 Word32
0x80000000

-- | A pure list of UUIDs that can be used in testing. This is
-- _almost_ a sequence counting up from zero, but we ensure that the
-- version and variant numbers are correctly set so the resulting UUIDs
-- validate.
mockUUIDs :: [UUID]
mockUUIDs :: [UUID]
mockUUIDs = Word32 -> UUID
sequenceIdToMockUUID (Word32 -> UUID) -> [Word32] -> [UUID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> Word32 -> [Word32]
forall a. Enum a => a -> a -> [a]
enumFromTo Word32
forall a. Bounded a => a
minBound Word32
forall a. Bounded a => a
maxBound