{-# LANGUAGE BlockArguments  #-}
{-# LANGUAGE RecordWildCards #-}
{-|
Description : Unique id generator derived from Twitter's Snowflake.
License     : Apache 2.0
Maintainer  : smokejumperit@gmail.com
Stability   : experimental

This generates unique (guaranteed) identifiers build from a timestamp,
counter, and node id.  Identifiers are convertible to values which are
monotonically increasing with respect to time.
-}
module Data.Snowchecked
( newSnowcheckedGen
, nextFlake
, SnowcheckedConfig(..)
, SnowcheckedGen
, Flake
, snowcheckedConfigBitCount
, uniqueFlakeCount
) where

import           Control.Concurrent.MVar
import           Control.Monad.IO.Class           (MonadIO, liftIO)
import           Data.Snowchecked.Internal.Import
import           Data.Time.Clock.POSIX            (getPOSIXTime)


currentTimestamp :: IO Word256
currentTimestamp :: IO Word256
currentTimestamp = POSIXTime -> Word256
toMillisWord256 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO POSIXTime
getPOSIXTime
	where
		toMillisWord256 :: POSIXTime -> Word256
toMillisWord256 = forall a b. (RealFrac a, Integral b) => a -> b
round forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Num a => a -> a -> a
*POSIXTime
1000)
{-# INLINE currentTimestamp #-}

currentTimestampBits :: Word8 -> IO Word256
currentTimestampBits :: Word8 -> IO Word256
currentTimestampBits Word8
n = 
	if Word8
n forall a. Eq a => a -> a -> Bool
== Word8
0 then
		forall (m :: * -> *) a. Monad m => a -> m a
return Word256
0
	else
		(forall a. (Num a, Bits a) => a -> Int -> a
`cutBits` forall a. Integral a => a -> Int
toInt Word8
n) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Word256
currentTimestamp
{-# INLINE currentTimestampBits #-}

-- | Create a new generator. Takes a configuration and node id.  The node id may be any
-- value that fits in a 'Word256', but it will be truncated to the number of bits specified
-- in the provided configuration.
newSnowcheckedGen :: (MonadIO io) => SnowcheckedConfig -> Word256 -> io SnowcheckedGen
newSnowcheckedGen :: forall (io :: * -> *).
MonadIO io =>
SnowcheckedConfig -> Word256 -> io SnowcheckedGen
newSnowcheckedGen conf :: SnowcheckedConfig
conf@SnowcheckedConfig{Word8
confCheckBits :: SnowcheckedConfig -> Word8
confNodeBits :: SnowcheckedConfig -> Word8
confCountBits :: SnowcheckedConfig -> Word8
confTimeBits :: SnowcheckedConfig -> Word8
confCheckBits :: Word8
confNodeBits :: Word8
confCountBits :: Word8
confTimeBits :: Word8
..} Word256
nodeId = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
	MVar Flake -> SnowcheckedGen
SnowcheckedGen forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. a -> IO (MVar a)
newMVar Flake
		{ flakeTime :: Word256
flakeTime = Word256
0
		, flakeCount :: Word256
flakeCount = Word256
0
		, flakeNodeId :: Word256
flakeNodeId = forall a. (Num a, Bits a) => a -> Int -> a
cutBits Word256
nodeId (forall a. Integral a => a -> Int
toInt Word8
confNodeBits)
		, flakeConfig :: SnowcheckedConfig
flakeConfig = SnowcheckedConfig
conf
		}
{-# INLINEABLE newSnowcheckedGen #-}
{-# SPECIALIZE newSnowcheckedGen :: SnowcheckedConfig -> Word256 -> IO SnowcheckedGen #-}

-- | Calculates the number of bits in each 'Flake' generated using a given configuration.
-- It returns a 'Word32' because there are 4 fields and the bitlength of each field fits
-- in a 'Word8', so the total bit count must fit within a 'Word32'.
snowcheckedConfigBitCount :: SnowcheckedConfig -> Word32
snowcheckedConfigBitCount :: SnowcheckedConfig -> Word32
snowcheckedConfigBitCount SnowcheckedConfig{Word8
confCheckBits :: Word8
confNodeBits :: Word8
confCountBits :: Word8
confTimeBits :: Word8
confCheckBits :: SnowcheckedConfig -> Word8
confNodeBits :: SnowcheckedConfig -> Word8
confCountBits :: SnowcheckedConfig -> Word8
confTimeBits :: SnowcheckedConfig -> Word8
..} = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Word8 -> Word32 -> Word32
foldFunc Word32
0
		[ Word8
confTimeBits
		, Word8
confCountBits
		, Word8
confNodeBits
		, Word8
confCheckBits
		]
	where
		foldFunc :: Word8 -> Word32 -> Word32
		foldFunc :: Word8 -> Word32 -> Word32
foldFunc Word8
nxt = (forall a. Num a => a -> a -> a
+ forall a. Integral a => a -> Word32
toWord32 Word8
nxt)
{-# INLINEABLE snowcheckedConfigBitCount #-}

-- | Generates the next id.
nextFlake :: (MonadIO io) => SnowcheckedGen -> io Flake
nextFlake :: forall (io :: * -> *). MonadIO io => SnowcheckedGen -> io Flake
nextFlake SnowcheckedGen{MVar Flake
genLastFlake :: SnowcheckedGen -> MVar Flake
genLastFlake :: MVar Flake
..} = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a b. MVar a -> (a -> IO (a, b)) -> IO b
modifyMVar MVar Flake
genLastFlake Flake -> IO (Flake, Flake)
mkNextFlake
	where
		-- TODO: Track the number of flakes generated and error out if we've exhausted them.
		mkNextFlake :: Flake -> IO (Flake, Flake)
mkNextFlake flake :: Flake
flake@Flake{Word256
SnowcheckedConfig
flakeConfig :: SnowcheckedConfig
flakeNodeId :: Word256
flakeCount :: Word256
flakeTime :: Word256
flakeConfig :: Flake -> SnowcheckedConfig
flakeNodeId :: Flake -> Word256
flakeCount :: Flake -> Word256
flakeTime :: Flake -> Word256
..} =
			let SnowcheckedConfig{Word8
confCheckBits :: Word8
confNodeBits :: Word8
confCountBits :: Word8
confTimeBits :: Word8
confCheckBits :: SnowcheckedConfig -> Word8
confNodeBits :: SnowcheckedConfig -> Word8
confCountBits :: SnowcheckedConfig -> Word8
confTimeBits :: SnowcheckedConfig -> Word8
..} = SnowcheckedConfig
flakeConfig in
			Word8 -> IO Word256
currentTimestampBits Word8
confTimeBits forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Word256
currentTimeBits ->
				if Word256
flakeTime forall a. Ord a => a -> a -> Bool
< Word256
currentTimeBits then
					let newFlake :: Flake
newFlake = Flake
flake { 
						flakeTime :: Word256
flakeTime = Word256
currentTimeBits, 
						flakeCount :: Word256
flakeCount = Word256
0 
					} in forall (m :: * -> *) a. Monad m => a -> m a
return (Flake
newFlake, Flake
newFlake)
				else if Word8
confTimeBits forall a. Eq a => a -> a -> Bool
== Word8
0 then
					let newFlake :: Flake
newFlake = Flake
flake
						{ flakeTime :: Word256
flakeTime = Word256
0
						, flakeCount :: Word256
flakeCount = Word256
flakeCount forall a. Num a => a -> a -> a
+ Word256
1
						}
					in forall (m :: * -> *) a. Monad m => a -> m a
return (Flake
newFlake, Flake
newFlake)
				else if Word8
confCountBits forall a. Eq a => a -> a -> Bool
== Word8
0 then
					let newFlake :: Flake
newFlake = Flake
flake
						{ flakeTime :: Word256
flakeTime = Word256
flakeTime forall a. Num a => a -> a -> a
+ Word256
1
						, flakeCount :: Word256
flakeCount = Word256
0
						}
					in forall (m :: * -> *) a. Monad m => a -> m a
return (Flake
newFlake, Flake
newFlake)
				else
					let nextCount :: Word256
nextCount = forall a. (Num a, Bits a) => a -> Int -> a
cutBits (Word256
flakeCount forall a. Num a => a -> a -> a
+ Word256
1) (forall a. Integral a => a -> Int
toInt Word8
confCountBits) in
					if Word256
nextCount forall a. Eq a => a -> a -> Bool
== Word256
0 then
						let newFlake :: Flake
newFlake = Flake
flake
							{ flakeTime :: Word256
flakeTime = Word256
flakeTime forall a. Num a => a -> a -> a
+ Word256
1
							, flakeCount :: Word256
flakeCount = Word256
0
							}
						in forall (m :: * -> *) a. Monad m => a -> m a
return (Flake
newFlake, Flake
newFlake)
					else
						let newFlake :: Flake
newFlake = Flake
flake { flakeCount :: Word256
flakeCount = Word256
nextCount }
						in forall (m :: * -> *) a. Monad m => a -> m a
return (Flake
newFlake, Flake
newFlake)
{-# INLINEABLE nextFlake #-}
{-# SPECIALIZE nextFlake :: SnowcheckedGen -> IO Flake #-}


-- | Provides the count of total number of unique flakes possibly generated by a node using
-- this configuration.
uniqueFlakeCount :: SnowcheckedConfig -> Integer
uniqueFlakeCount :: SnowcheckedConfig -> Integer
uniqueFlakeCount SnowcheckedConfig{Word8
confCheckBits :: Word8
confNodeBits :: Word8
confCountBits :: Word8
confTimeBits :: Word8
confCheckBits :: SnowcheckedConfig -> Word8
confNodeBits :: SnowcheckedConfig -> Word8
confCountBits :: SnowcheckedConfig -> Word8
confTimeBits :: SnowcheckedConfig -> Word8
..}
	| Word8
confCountBits forall a. Eq a => a -> a -> Bool
== Word8
0 = Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^Word8
confTimeBits
	| Word8
confTimeBits  forall a. Eq a => a -> a -> Bool
== Word8
0 = Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^Word8
confCountBits
	| Bool
otherwise          = Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^Word8
confCountBits forall a. Num a => a -> a -> a
* Integer
2forall a b. (Num a, Integral b) => a -> b -> a
^Word8
confTimeBits
{-# INLINE uniqueFlakeCount #-}