{-# LANGUAGE TypeFamilies #-}
module Data.UUID.Util (
    UnpackedUUID(..)
  , unpack, pack
  , version
  , extractMac
  , extractTime
  , setTime
  ) where

import Prelude hiding (null)
import Data.Word
import Data.Word.Util
import Data.Bits
import Data.UUID.Types.Internal
import Network.Info
import Data.Int (Int64)

version :: UUID -> Int
version :: UUID -> Int
version UUID
uuid =
    Word16 -> Int
forall a. Enum a => a -> Int
fromEnum ((UnpackedUUID -> Word16
time_hi_and_version UnpackedUUID
unpacked Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
`shiftR` Int
12) Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0xF)
  where
    unpacked :: UnpackedUUID
unpacked = UUID -> UnpackedUUID
unpack UUID
uuid

-- Note UUID time is in 10^-7 seconds.
setTime :: (Integral a, Bits a) => UUID -> a -> Maybe UUID
setTime :: UUID -> a -> Maybe UUID
setTime UUID
uuid a
t =
  if UUID -> Int
version UUID
uuid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
  then UUID -> Maybe UUID
forall a. a -> Maybe a
Just (UUID -> Maybe UUID) -> UUID -> Maybe UUID
forall a b. (a -> b) -> a -> b
$ UnpackedUUID -> UUID
pack (UnpackedUUID -> UUID) -> UnpackedUUID -> UUID
forall a b. (a -> b) -> a -> b
$ (UUID -> UnpackedUUID
unpack UUID
uuid){time_low :: Word32
time_low = Word32
new_low_bits, time_mid :: Word16
time_mid = Word16
new_mid_bits, time_hi_and_version :: Word16
time_hi_and_version = Word16
new_hi_and_version_bits}
  else Maybe UUID
forall a. Maybe a
Nothing
       where new_low_bits :: Word32
new_low_bits = a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word32) -> a -> Word32
forall a b. (a -> b) -> a -> b
$ a
t a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFFFFFF
             new_mid_bits :: Word16
new_mid_bits = a -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word16) -> a -> Word16
forall a b. (a -> b) -> a -> b
$ (a
t a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
32) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0xFFFF
             new_hi_and_version_bits :: Word16
new_hi_and_version_bits = a -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (a -> Word16) -> a -> Word16
forall a b. (a -> b) -> a -> b
$ a
0x1000 a -> a -> a
forall a. Bits a => a -> a -> a
.|. ((a
t a -> Int -> a
forall a. Bits a => a -> Int -> a
`shiftR` Int
48) a -> a -> a
forall a. Bits a => a -> a -> a
.&. a
0x0FFF)

extractTime :: UUID -> Maybe Int64
extractTime :: UUID -> Maybe Int64
extractTime UUID
uuid =
  if UUID -> Int
version UUID
uuid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
  then Int64 -> Maybe Int64
forall a. a -> Maybe a
Just (Int64 -> Maybe Int64) -> Int64 -> Maybe Int64
forall a b. (a -> b) -> a -> b
$ Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word64
w32to64 (Word16 -> Word16 -> Word32
w16to32 (Word16 -> Word16
timeAndVersionToTime (Word16 -> Word16) -> Word16 -> Word16
forall a b. (a -> b) -> a -> b
$ UnpackedUUID -> Word16
time_hi_and_version UnpackedUUID
unpacked) (Word16 -> Word32) -> Word16 -> Word32
forall a b. (a -> b) -> a -> b
$ UnpackedUUID -> Word16
time_mid UnpackedUUID
unpacked) (UnpackedUUID -> Word32
time_low UnpackedUUID
unpacked)
  else Maybe Int64
forall a. Maybe a
Nothing
  where
    unpacked :: UnpackedUUID
unpacked = UUID -> UnpackedUUID
unpack UUID
uuid

timeAndVersionToTime :: Word16 -> Word16
timeAndVersionToTime :: Word16 -> Word16
timeAndVersionToTime Word16
tv = Word16
tv Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
.&. Word16
0x0FFF

extractMac :: UUID -> Maybe MAC
extractMac :: UUID -> Maybe MAC
extractMac UUID
uuid =
  if UUID -> Int
version UUID
uuid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
  then MAC -> Maybe MAC
forall a. a -> Maybe a
Just (MAC -> Maybe MAC) -> MAC -> Maybe MAC
forall a b. (a -> b) -> a -> b
$
       Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> Word8 -> MAC
MAC (UnpackedUUID -> Word8
node_0 UnpackedUUID
unpacked) (UnpackedUUID -> Word8
node_1 UnpackedUUID
unpacked) (UnpackedUUID -> Word8
node_2 UnpackedUUID
unpacked) (UnpackedUUID -> Word8
node_3 UnpackedUUID
unpacked) (UnpackedUUID -> Word8
node_4 UnpackedUUID
unpacked) (UnpackedUUID -> Word8
node_5 UnpackedUUID
unpacked)
  else Maybe MAC
forall a. Maybe a
Nothing
  where
    unpacked :: UnpackedUUID
unpacked = UUID -> UnpackedUUID
unpack UUID
uuid