snowchecked 0.0.0.3 → 0.0.1.0

raw patch · 12 files changed

+229/−45 lines, 12 filesdep +textdep +text-conversionsPVP ok

version bump matches the API change (PVP)

Dependencies added: text, text-conversions

API changes (from Hackage documentation)

Files

• README.md +9/−3
• package.yaml +3/−1
• snowchecked.cabal +8/−1
• src/Data/Snowchecked.hs +8/−2
• src/Data/Snowchecked/Encoding/ByteString.hs +4/−4
• src/Data/Snowchecked/Encoding/Class.hs +1/−2
• src/Data/Snowchecked/Encoding/Integral.hs +5/−5
• src/Data/Snowchecked/Encoding/Text.hs +112/−0
• src/Data/Snowchecked/Types.hs +32/−27
• test/Spec.hs +4/−0
• test/String.hs +21/−0
• test/Text.hs +22/−0

@@ -9,7 +9,8 @@ the number of checksum bits set to 0, then you have a Snowflake implementation.  This extension is valuable because the checksum detects error on input. If you're using ids in a human setting-(eg: having users type them in), then the checksum is valuable to catch typos, miscommunications, and other input issues.+(eg: having users type them in or scan them from QR codes), then the checksum is valuable to catch typos,+miscommunications, and other input issues.  Like Snowflake, this algorithm uses some bits from the timestamp, some bits from a counter, and some bits of the node id. This algorithm extends Snowflake by also using some bits to store the checksum, which derives from the sum of the other@@ -18,9 +19,14 @@ This implementation allows the number of bits in the id to range from 0 bits to 255^4 bits. The default configuration uses 64 bits, with 40 bits used for time, 10 bits used for the counter, 8 bits used for the node id, and 6 bits for the checksum. The odds of a false positive on the checksum is `1/(2^checkbits)`, so the odds of a false positive in the default configuration-is ~1.5%. This configuration can generate 1024 UIDs per millisecond per node: the 1025th request to a node for a UID in that-millisecond will cause a pause in the thread for one millisecond, and then the counter will reset to 0. (If you need more UIDs+is ~1.5%. This configuration can generate 1024 UIDs per millisecond per node: the 1025th request in a given millisecond+will cause a pause in the thread for one millisecond, and then the counter will reset to 0. (If you need more UID throughput than that, then create more generators with distinct node ids.)++## Encoding++If you want to marshall a flake, then you can use the encodings in the `Encoding` sub-packages of this library. Implementations+include a `ByteString` (strict or lazy), any `Text`-like value (using base 16), or any `Integral` value.  # Credit 

@@ -1,5 +1,5 @@ name: snowchecked-version: 0.0.0.3+version: 0.0.1.0 github: robertfischer/hs-snowflake-checked license: Apache-2.0 author: Robert Fischer@@ -29,6 +29,8 @@   - data-default >= 0.7.1.1   - time >= 1.9.3   - deepseq >= 1.4.4.0+  - text-conversions >= 0.3.1+  - text >= 1.2.4.1  ghc-options:   - -Wall

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           snowchecked-version:        0.0.0.3+version:        0.0.1.0 synopsis:       A checksummed variation on Twitter's Snowflake UID generation algorithm description:    See the file ./README.md, which is included in the package and also on GitHub. category:       Data@@ -35,6 +35,7 @@       Data.Snowchecked.Encoding.ByteString.Lazy       Data.Snowchecked.Encoding.Class       Data.Snowchecked.Encoding.Integral+      Data.Snowchecked.Encoding.Text       Data.Snowchecked.Internal.Import       Data.Snowchecked.Types   other-modules:@@ -47,6 +48,8 @@     , bytestring >=0.10.12.0     , data-default >=0.7.1.1     , deepseq >=1.4.4.0+    , text >=1.2.4.1+    , text-conversions >=0.3.1     , time >=1.9.3     , wide-word >=0.1.1.2   default-language: Haskell2010@@ -57,6 +60,8 @@   other-modules:       Gens       Integer+      String+      Text       Word32       Word64       Paths_snowchecked@@ -70,6 +75,8 @@     , deepseq >=1.4.4.0     , hedgehog     , snowchecked+    , text >=1.2.4.1+    , text-conversions >=0.3.1     , time >=1.9.3     , wide-word >=0.1.1.2   default-language: Haskell2010

@@ -38,7 +38,9 @@ currentTimestampBits n = (`cutBits` fromIntegral n) <$> currentTimestamp {-# INLINE currentTimestampBits #-} --- | Create a new generator. Takes a configuration and node id.+-- | 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 conf@SnowcheckedConfig{..} nodeId = liftIO $ do 	startTimeBits <- currentTimestampBits confTimeBits@@ -51,6 +53,9 @@ {-# 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{..} = foldr foldFunc 0 		[ confTimeBits@@ -93,7 +98,8 @@ {-# SPECIALIZE nextFlake :: SnowcheckedGen -> IO Flake #-}  --- | Provides the count of total number of unique flakes possibly generated by this configuration.+-- | Provides the count of total number of unique flakes possibly generated by a node using+-- this configuration. uniqueFlakeCount :: SnowcheckedConfig -> Integer uniqueFlakeCount SnowcheckedConfig{..} = toInteger confCountBits * toInteger confTimeBits {-# INLINE uniqueFlakeCount #-}

@@ -2,10 +2,10 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans      #-} {-|- - This module provides a conversion function between a- - 'Flake' and a strict 'ByteString'.  The 'ByteString'- - is the series of bytes that make up the 'Flake', with- - the lower bytes being in the lower indecies.+ This module provides a conversion function between a+ 'Flake' and a strict 'ByteString'.  The 'ByteString'+ is the series of bytes that make up the 'Flake', with+ the lower bytes being in the lower indecies. -}  module Data.Snowchecked.Encoding.ByteString

@@ -4,8 +4,7 @@  import           Data.Snowchecked.Internal.Import -{-| Something that might be a 'Flake'.  The fields might not be truncated- - to the appropriate size.+{-| Something that might be a 'Flake'.  The fields might not be truncated to the appropriate size.  -} data Flakeish = Flakeish 	{ fishNodeId    ::  Word256

@@ -3,11 +3,11 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans      #-} {-|- - This module provides a generalized conversion function between a- - 'Flake' and all members of the typeclass 'Integral'.  It is specialized- - for the 'Integer', 'Word32', and 'Word64' types. It is marked as- - incoherent due to the constraint being no smaller than the instance type,- - so it is undecidable.+ This module provides a generalized conversion function between a+ 'Flake' and all members of the typeclass 'Integral'.  It is specialized+ for the 'Integer', 'Word32', and 'Word64' types. It is marked as+ incoherent due to the constraint being no smaller than the instance type,+ so it is undecidable. -}  module Data.Snowchecked.Encoding.Integral

@@ -0,0 +1,112 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE RecordWildCards      #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans      #-}+{-|+ This module provides a generalized conversion function between a+ 'Flake' and all types that are members of both 'FromText' and 'ToText'.+ It is specialized for the strict 'Text' and 'String' types. It is marked as+ incoherent due to the constraint being no smaller than the instance type,+ so it is undecidable.++ To specify how you want the conversion to be performed, you need to wrap the+ text-like type the 'Base16' constructor.  Other encodings (eg: Base64) may+ be added later.++ Note that when converting to a 'Flake', the implementation silently discards+ characters other than digits, 'a'-'f', and 'A'-'F'.  This allows you to+ apply formatting to the Flake.+-}++module Data.Snowchecked.Encoding.Text+	( module Data.Snowchecked.Encoding.Class+	, module Data.Text.Conversions+	) where++import           Control.Applicative                       ((<|>))+import qualified Data.ByteString.Lazy                      as LBS+import qualified Data.List                                 as L+import           Data.Maybe                                (catMaybes)+import           Data.Snowchecked.Encoding.ByteString.Lazy ()+import           Data.Snowchecked.Encoding.Class+import           Data.Snowchecked.Internal.Import+import qualified Data.Text                                 as T+import           Data.Text.Conversions+import           Text.Read                                 (readMaybe)++-- | Convert a hex value to a character.+--+--   WARNING: This function returns the null character ('\0') if you pass in a value > 15.+c :: Word8 -> Char+c 0  = '0'+c 1  = '1'+c 2  = '2'+c 3  = '3'+c 4  = '4'+c 5  = '5'+c 6  = '6'+c 7  = '7'+c 8  = '8'+c 9  = '9'+c 10 = 'a'+c 11 = 'b'+c 12 = 'c'+c 13 = 'd'+c 14 = 'e'+c 15 = 'f'+c _  = '\0'++-- | Converts a character to a hex value (if there is one).+b :: Char -> Maybe Word8+b ch = readMaybe [ch] <|> chLookup+	where+		chLookup = case ch of+			'A' -> Just 10+			'a' -> Just 10+			'B' -> Just 11+			'b' -> Just 11+			'C' -> Just 12+			'c' -> Just 12+			'D' -> Just 13+			'd' -> Just 13+			'E' -> Just 14+			'e' -> Just 14+			'F' -> Just 15+			'f' -> Just 15+			_   -> Nothing++-- | Converts a byte to two hex characters: low nibble and then high nibble.+byteToHex :: Word8 -> (Char,Char)+byteToHex w8 = (c lowNibble, c highNibble)+	where+		lowNibble = cutBits w8 4+		highNibble = shiftCutBits w8 4 4++instance {-# INCOHERENT #-} (ToText a, FromText a) => IsFlake (Base16 a) where+	fromFlake flake = Base16 $ convertText str+		where+			str = LBS.foldr bytesToChars [] $ fromFlake flake+			bytesToChars w8 rest =+				let (lowC, highC) = byteToHex w8 in lowC : highC : rest+	{-# INLINEABLE fromFlake #-}+	{-# SPECIALIZE fromFlake :: Flake -> Base16 String #-}+	{-# SPECIALIZE fromFlake :: Flake -> Base16 T.Text #-}++	parseFish SnowcheckedConfig{..} (Base16 raw) = return $ Flakeish+			{ fishCheck = fromIntegral $ cutBits n checkBitsInteger+			, fishNodeId = fromIntegral $ shiftCutBits n checkBitsInteger nodeBitsInteger+			, fishCount = fromIntegral $ shiftCutBits n (checkBitsInteger + nodeBitsInteger) countBitsInteger+			, fishTime = fromIntegral $ shiftCutBits n (checkBitsInteger + nodeBitsInteger + countBitsInteger) timeBitsInteger+			}+		where+			nibbles = catMaybes . T.foldr toNibbles [] $ toText raw+			n = L.foldr addNibbles 0 nibbles+			addNibbles nib total = toInteger nib + ( total `shiftL` 4 )+			toNibbles ch lst = b ch : lst+			checkBitsInteger = toInteger confCheckBits+			nodeBitsInteger = toInteger confNodeBits+			timeBitsInteger = toInteger confTimeBits+			countBitsInteger = toInteger confCountBits+	{-# INLINEABLE parseFish #-}+	{-# SPECIALIZE parseFish :: (MonadFail m) => SnowcheckedConfig -> Base16 T.Text -> m Flakeish #-}+	{-# SPECIALIZE parseFish :: (MonadFail m) => SnowcheckedConfig -> Base16 String -> m Flakeish #-}

@@ -9,8 +9,8 @@ and therefore should only be imported by Data.Snowchecked. -} module Data.Snowchecked.Types-  ( module Data.Snowchecked.Types )-  where+	( module Data.Snowchecked.Types )+	where  import           Control.Concurrent.MVar import           Control.DeepSeq         (NFData)@@ -20,46 +20,51 @@ import           GHC.Generics            (Generic)  {-|-Configuration that specifies how much bits are used for each part of the id.+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. However, 4 bits are taken from the count-bits and used for check bits.  Note that specifying 0 check bits results in-the normal snowflake generation.+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-  { confTimeBits  :: Word8  -- ^ Number of bits used to hold the time-  , confCountBits :: Word8  -- ^ Number of bits used to count instances per-time-  , confNodeBits  :: Word8  -- ^ Number of bits derived from the node id-  , confCheckBits :: Word8  -- ^ Number of bits used to store the checksum-  } deriving (Eq, Show, Generic)+	{ confTimeBits         :: Word8  -- ^ Number of bits used to hold the time+	, confCountBits        :: Word8  -- ^ Number of bits used to count instances per-time+	, confNodeBits         :: Word8  -- ^ Number of bits derived from the node id+	, confCheckBits        :: Word8  -- ^ Number of bits used to store the checksum+	} deriving (Eq, Show, Generic)  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-    { confTimeBits = 40-    , confCountBits = 10-    , confNodeBits = 8-    , confCheckBits = 6-    }+	{-|+		A configuration using 40 bits for time, 10 bits for count, 8 bits for node id,+		and 6 bits for the checksum.+	-}+	def = SnowcheckedConfig+		{ confTimeBits = 40+		, confCountBits = 10+		, confNodeBits = 8+		, confCheckBits = 6+		} -{-| The state that needs to be communicated between flake generation calls.- -  This should not be accessed or created directly by consumers of this library:- -  doing so may cause your code to hang indefinitely.+{-|+	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 { genLastFlake :: MVar Flake }  {-| The state of a given generated instance. Note that the actual value is calculated on demand. -} data Flake = Flake-  { flakeTime   :: Word256 -- ^ The bit-truncated time-  , flakeCount  :: Word256 -- ^ The bit-truncated count-  , flakeNodeId :: Word256 -- ^ The bit-truncated node id-  , flakeConfig :: SnowcheckedConfig -- ^ The configuration used to create the flake.+	{ flakeTime          :: Word256 -- ^ The bit-truncated time+	, flakeCount         :: Word256 -- ^ The bit-truncated count+	, flakeNodeId        :: Word256 -- ^ The bit-truncated node id+	, flakeConfig        :: SnowcheckedConfig -- ^ The configuration used to create the flake.  } deriving (Eq,Show,Generic)  instance NFData Flake

@@ -17,6 +17,8 @@ import qualified Integer import qualified Word32 import qualified Word64+import qualified Text+import qualified String  main :: IO () main = do@@ -29,6 +31,8 @@ 			, Integer.tests 			, Word32.tests 			, Word64.tests+			, Text.tests+			, String.tests 			]  prop_generatesUniqueValues :: Property

@@ -0,0 +1,21 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE TypeApplications    #-}++module String (tests) where++import           Data.Snowchecked+import           Data.Snowchecked.Encoding.Text+import           Gens+import           Hedgehog++tests :: IO Bool+tests = checkParallel $$(discover)++prop_flakeToStringToFlake :: Property+prop_flakeToStringToFlake = property $ do+		cfg <- forAll genConfig+		flake <- forAllFlake' cfg+		let (value::Base16 String) = fromFlake flake+		let result = parseFlake cfg value+		result === Just flake

@@ -0,0 +1,22 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell     #-}+{-# LANGUAGE TypeApplications    #-}++module Text (tests) where++import           Data.Snowchecked+import           Data.Snowchecked.Encoding.Text+import           Data.Text                      (Text)+import           Gens+import           Hedgehog++tests :: IO Bool+tests = checkParallel $$(discover)++prop_flakeToStrictTextToFlake :: Property+prop_flakeToStrictTextToFlake = property $ do+		cfg <- forAll genConfig+		flake <- forAllFlake' cfg+		let (value::Base16 Text) = fromFlake flake+		let result = parseFlake cfg value+		result === Just flake