{-# LANGUAGE DeriveGeneric #-}
{-|
Description : Types for the Data.Snowchecked module
License     : Apache 2.0
Maintainer  : smokejumperit@gmail.com
Stability   : experimental

This module is internal, subject to breaking changes without a major version increment,
and therefore should only be imported by Data.Snowchecked.
-}
module Data.Snowchecked.Types
	( module Data.Snowchecked.Types )
	where

import           Control.Concurrent.MVar
import           Control.DeepSeq         (NFData)
import           Data.Default
import           Data.WideWord.Word256
import           Data.Word
import           GHC.Generics            (Generic)

{-|
Configuration that specifies how many bits are used for each part of the id.
These values are not validated and may be any legal value for the type.

The default value provided by 'def' is 64 bits in total length, just like
the original Snowflake algorithm.

Note that specifying 0 check bits results in the normal Snowflake generation.
Setting 'confTimeBits' or 'confCountBits' near zero will significantly limit
the total number of UIDs that can be generated, as well as the throughput of
the UID generation.
-}
data SnowcheckedConfig = SnowcheckedConfig
	{ SnowcheckedConfig -> Word8
confTimeBits         :: Word8  -- ^ Number of bits used to hold the time
	, SnowcheckedConfig -> Word8
confCountBits        :: Word8  -- ^ Number of bits used to count instances per-time
	, SnowcheckedConfig -> Word8
confNodeBits         :: Word8  -- ^ Number of bits derived from the node id
	, SnowcheckedConfig -> Word8
confCheckBits        :: Word8  -- ^ Number of bits used to store the checksum
	} deriving (SnowcheckedConfig -> SnowcheckedConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
$c/= :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
== :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
$c== :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
Eq, Int -> SnowcheckedConfig -> ShowS
[SnowcheckedConfig] -> ShowS
SnowcheckedConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SnowcheckedConfig] -> ShowS
$cshowList :: [SnowcheckedConfig] -> ShowS
show :: SnowcheckedConfig -> String
$cshow :: SnowcheckedConfig -> String
showsPrec :: Int -> SnowcheckedConfig -> ShowS
$cshowsPrec :: Int -> SnowcheckedConfig -> ShowS
Show, forall x. Rep SnowcheckedConfig x -> SnowcheckedConfig
forall x. SnowcheckedConfig -> Rep SnowcheckedConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SnowcheckedConfig x -> SnowcheckedConfig
$cfrom :: forall x. SnowcheckedConfig -> Rep SnowcheckedConfig x
Generic, Eq SnowcheckedConfig
SnowcheckedConfig -> SnowcheckedConfig -> Bool
SnowcheckedConfig -> SnowcheckedConfig -> Ordering
SnowcheckedConfig -> SnowcheckedConfig -> SnowcheckedConfig
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SnowcheckedConfig -> SnowcheckedConfig -> SnowcheckedConfig
$cmin :: SnowcheckedConfig -> SnowcheckedConfig -> SnowcheckedConfig
max :: SnowcheckedConfig -> SnowcheckedConfig -> SnowcheckedConfig
$cmax :: SnowcheckedConfig -> SnowcheckedConfig -> SnowcheckedConfig
>= :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
$c>= :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
> :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
$c> :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
<= :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
$c<= :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
< :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
$c< :: SnowcheckedConfig -> SnowcheckedConfig -> Bool
compare :: SnowcheckedConfig -> SnowcheckedConfig -> Ordering
$ccompare :: SnowcheckedConfig -> SnowcheckedConfig -> Ordering
Ord)

instance NFData SnowcheckedConfig

instance Default SnowcheckedConfig where
	{-|
		A configuration using 40 bits for time, 10 bits for count, 8 bits for node id,
		and 6 bits for the checksum.
	-}
	def :: SnowcheckedConfig
def = SnowcheckedConfig
		{ confTimeBits :: Word8
confTimeBits = Word8
40
		, confCountBits :: Word8
confCountBits = Word8
10
		, confNodeBits :: Word8
confNodeBits = Word8
8
		, confCheckBits :: Word8
confCheckBits = Word8
6
		}

{-|
	The state that needs to be communicated between flake generation calls.
	This should be treated as opaque by consumers of this library: messing
	about with its internals may cause your code to hang indefinitely.
 -}
newtype SnowcheckedGen = SnowcheckedGen { SnowcheckedGen -> MVar Flake
genLastFlake :: MVar Flake }

{-| The state of a given generated instance. Note that the actual value is calculated on demand. -}
data Flake = Flake
	{ Flake -> Word256
flakeTime          :: Word256 -- ^ The bit-truncated time
	, Flake -> Word256
flakeCount         :: Word256 -- ^ The bit-truncated count
	, Flake -> Word256
flakeNodeId        :: Word256 -- ^ The bit-truncated node id
	, Flake -> SnowcheckedConfig
flakeConfig        :: SnowcheckedConfig -- ^ The configuration used to create the flake.
 } deriving (Flake -> Flake -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flake -> Flake -> Bool
$c/= :: Flake -> Flake -> Bool
== :: Flake -> Flake -> Bool
$c== :: Flake -> Flake -> Bool
Eq,Int -> Flake -> ShowS
[Flake] -> ShowS
Flake -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flake] -> ShowS
$cshowList :: [Flake] -> ShowS
show :: Flake -> String
$cshow :: Flake -> String
showsPrec :: Int -> Flake -> ShowS
$cshowsPrec :: Int -> Flake -> ShowS
Show,Eq Flake
Flake -> Flake -> Bool
Flake -> Flake -> Ordering
Flake -> Flake -> Flake
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Flake -> Flake -> Flake
$cmin :: Flake -> Flake -> Flake
max :: Flake -> Flake -> Flake
$cmax :: Flake -> Flake -> Flake
>= :: Flake -> Flake -> Bool
$c>= :: Flake -> Flake -> Bool
> :: Flake -> Flake -> Bool
$c> :: Flake -> Flake -> Bool
<= :: Flake -> Flake -> Bool
$c<= :: Flake -> Flake -> Bool
< :: Flake -> Flake -> Bool
$c< :: Flake -> Flake -> Bool
compare :: Flake -> Flake -> Ordering
$ccompare :: Flake -> Flake -> Ordering
Ord,forall x. Rep Flake x -> Flake
forall x. Flake -> Rep Flake x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Flake x -> Flake
$cfrom :: forall x. Flake -> Rep Flake x
Generic)

instance NFData Flake