packages feed

snowchecked (empty) → 0.0.0.1

raw patch · 15 files changed

+725/−0 lines, 15 filesdep +basedep +bytestringdep +data-defaultsetup-changed

Dependencies added: base, bytestring, data-default, deepseq, hedgehog, snowchecked, time, wide-word

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Robert Fischer (c) 2021++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Robert Fischer nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,27 @@+# SnowChecked++## A Checksummed UID Generator based on Twitter's Snowflake++Unique ids are useful, but traditional GUID/UUID formats are lengthy, inefficient, and hard for humans to use. Twitter+created a novel format for UIDs called ["Snowflake"](https://developer.twitter.com/en/docs/twitter-ids) which addressed+these issues, with the added benefit that the UIDs monotonically increase over time.+This library extends the Snowflake format by adding checksum bits at the end. If you use this library with+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.++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+parts.++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+than that, then create more generators with distinct node ids.)++# Credit++This project derives distantly from the [`snowfake` package on Hackage](https://hackage.haskell.org/package/snowflake).
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ package.yaml view
@@ -0,0 +1,79 @@+name: snowchecked+version: 0.0.0.1+github: robertfischer/hs-snowflake-checked+license: Apache-2.0+author: Robert Fischer+maintainer: smokejumperit@gmail.com+copyright: 2021 Robert Fischer++extra-source-files:+  - LICENSE+  - README.md+  - package.yaml+  - stack.yaml+  - stack.yaml.lock++# Metadata used when publishing your package+synopsis: A checksummed variation on Twitter's Snowflake UID generation algorithm+category: Data++# To avoid duplicated efforts in documentation and dealing with the+# complications of embedding Haddock markup inside cabal files, it is+# common to point users to the README.md file.+description: See the file ./README.md, which is included in the package and also on GitHub.++dependencies:+  - base >= 4.14.1.0 && < 4.15+  - bytestring >= 0.10.12.0+  - wide-word >= 0.1.1.2+  - data-default >= 0.7.1.1+  - time >= 1.9.3+  - deepseq >= 1.4.4.0++ghc-options:+  - -Wall+  - -Wcompat+  - -Widentities+  - -Werror=unused-do-bind+  - -Werror=incomplete-record-updates+  - -Werror=incomplete-uni-patterns+  - -Werror=partial-fields+  - -Werror=incomplete-patterns+  - -Wredundant-constraints+  - -Werror=missing-exported-signatures+  - -Wmissed-specializations+  - -Wno-unused-packages+  - -Wunused-type-patterns+  - -Werror=warnings-deprecations+  - -Wnoncanonical-monad-instances+  - -Wno-type-defaults+  - -Wno-tabs+  - -feager-blackholing+  - -fexcess-precision+  - -flate-dmd-anal+  - -fmax-inline-alloc-size=1024+  - -fmax-simplifier-iterations=8+  - -fpedantic-bottoms+  - -fregs-iterative+  - -fsimplifier-phases=4+  - -fspec-constr-count=10+  - -fspecialise-aggressively+  - -flate-specialise+  - -fstatic-argument-transformation+  - -fstrictness-before=3++library:+  source-dirs: src++tests:+  test-suite:+    main: Spec.hs+    source-dirs: test+    dependencies:+      - snowchecked+      - hedgehog++    ghc-options:+      - -threaded+      - -rtsopts+      - -with-rtsopts=-N
+ snowchecked.cabal view
@@ -0,0 +1,71 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           snowchecked+version:        0.0.0.1+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+homepage:       https://github.com/robertfischer/hs-snowflake-checked#readme+bug-reports:    https://github.com/robertfischer/hs-snowflake-checked/issues+author:         Robert Fischer+maintainer:     smokejumperit@gmail.com+copyright:      2021 Robert Fischer+license:        Apache-2.0+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    LICENSE+    README.md+    package.yaml+    stack.yaml+    stack.yaml.lock++source-repository head+  type: git+  location: https://github.com/robertfischer/hs-snowflake-checked++library+  exposed-modules:+      Data.Snowchecked+      Data.Snowchecked.Encoding.ByteString+      Data.Snowchecked.Encoding.ByteString.Lazy+      Data.Snowchecked.Encoding.Class+      Data.Snowchecked.Encoding.Integral+      Data.Snowchecked.Internal.Import+      Data.Snowchecked.Types+  other-modules:+      Paths_snowchecked+  hs-source-dirs:+      src+  ghc-options: -Wall -Wcompat -Widentities -Werror=unused-do-bind -Werror=incomplete-record-updates -Werror=incomplete-uni-patterns -Werror=partial-fields -Werror=incomplete-patterns -Wredundant-constraints -Werror=missing-exported-signatures -Wmissed-specializations -Wno-unused-packages -Wunused-type-patterns -Werror=warnings-deprecations -Wnoncanonical-monad-instances -Wno-type-defaults -Wno-tabs -feager-blackholing -fexcess-precision -flate-dmd-anal -fmax-inline-alloc-size=1024 -fmax-simplifier-iterations=8 -fpedantic-bottoms -fregs-iterative -fsimplifier-phases=4 -fspec-constr-count=10 -fspecialise-aggressively -flate-specialise -fstatic-argument-transformation -fstrictness-before=3+  build-depends:+      base >=4.14.1.0 && <4.15+    , bytestring >=0.10.12.0+    , data-default >=0.7.1.1+    , deepseq >=1.4.4.0+    , time >=1.9.3+    , wide-word >=0.1.1.2+  default-language: Haskell2010++test-suite test-suite+  type: exitcode-stdio-1.0+  main-is: Spec.hs+  other-modules:+      Paths_snowchecked+  hs-source-dirs:+      test+  ghc-options: -Wall -Wcompat -Widentities -Werror=unused-do-bind -Werror=incomplete-record-updates -Werror=incomplete-uni-patterns -Werror=partial-fields -Werror=incomplete-patterns -Wredundant-constraints -Werror=missing-exported-signatures -Wmissed-specializations -Wno-unused-packages -Wunused-type-patterns -Werror=warnings-deprecations -Wnoncanonical-monad-instances -Wno-type-defaults -Wno-tabs -feager-blackholing -fexcess-precision -flate-dmd-anal -fmax-inline-alloc-size=1024 -fmax-simplifier-iterations=8 -fpedantic-bottoms -fregs-iterative -fsimplifier-phases=4 -fspec-constr-count=10 -fspecialise-aggressively -flate-specialise -fstatic-argument-transformation -fstrictness-before=3 -threaded -rtsopts -with-rtsopts=-N+  build-depends:+      base >=4.14.1.0 && <4.15+    , bytestring >=0.10.12.0+    , data-default >=0.7.1.1+    , deepseq >=1.4.4.0+    , hedgehog+    , snowchecked+    , time >=1.9.3+    , wide-word >=0.1.1.2+  default-language: Haskell2010
+ src/Data/Snowchecked.hs view
@@ -0,0 +1,99 @@+{-# LANGUAGE BlockArguments   #-}+{-# LANGUAGE RecordWildCards  #-}+{-# LANGUAGE TypeApplications #-}+{-|+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               (threadDelay)+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 = toMillisWord256 <$> getPOSIXTime+	where+		toMillisWord256 = round . (*1000)+{-# INLINE currentTimestamp #-}++currentTimestampBits :: Word8 -> IO Word256+currentTimestampBits n = (`cutBits` fromIntegral n) <$> currentTimestamp+{-# INLINE currentTimestampBits #-}++-- | Create a new generator. Takes a configuration and node id.+newSnowcheckedGen :: (MonadIO io) => SnowcheckedConfig -> Word256 -> io SnowcheckedGen+newSnowcheckedGen conf@SnowcheckedConfig{..} nodeId = liftIO $ do+	startTimeBits <- currentTimestampBits confTimeBits+	SnowcheckedGen <$> newMVar Flake+		{ flakeTime = startTimeBits+		, flakeCount = 0+		, flakeNodeId = cutBits nodeId confNodeBits+		, flakeConfig = conf+		}+{-# INLINEABLE newSnowcheckedGen #-}+{-# SPECIALIZE newSnowcheckedGen :: SnowcheckedConfig -> Word256 -> IO SnowcheckedGen #-}++snowcheckedConfigBitCount :: SnowcheckedConfig -> Word32+snowcheckedConfigBitCount SnowcheckedConfig{..} = foldr foldFunc 0+		[ confTimeBits+		, confCountBits+		, confNodeBits+		, confCheckBits+		]+	where+		foldFunc :: Word8 -> Word32 -> Word32+		foldFunc nxt memo = memo + toWord32 nxt+{-# INLINEABLE snowcheckedConfigBitCount #-}++-- | Generates the next id.+nextFlake :: (MonadIO io) => SnowcheckedGen -> io Flake+nextFlake SnowcheckedGen{..} = liftIO $ modifyMVar genLastFlake mkNextFlake+	where+		-- TODO: Special case when confTimeBits is 0.+		-- TODO: Track the number of flakes generated and error out if we've exhausted them.+		mkNextFlake flake@Flake{..} =+			let SnowcheckedConfig{..} = flakeConfig in+			currentTimestampBits confTimeBits >>= \currentTimeBits ->+				if flakeTime < currentTimeBits then+					let newFlake = flake+						{ flakeTime = currentTimeBits+						, flakeCount = 0+						}+					in return (newFlake, newFlake)+				else if confCountBits == 0 then+					threadDelay 1000 >> mkNextFlake flake+				else+					let nextCount = cutBits (flakeCount + 1) confCountBits in+					if flakeCount < nextCount then+						let newFlake = flake { flakeCount = nextCount }+						in return (newFlake, newFlake)+					else+						-- The count wrapped and we need to wait for the time to change.+						-- This assumes that the next millisecond will give us a new time.+						threadDelay 1000 >> mkNextFlake flake+{-# INLINEABLE nextFlake #-}+{-# SPECIALIZE nextFlake :: SnowcheckedGen -> IO Flake #-}+++-- | Provides the count of total number of unique flakes possibly generated by this configuration.+uniqueFlakeCount :: SnowcheckedConfig -> Integer+uniqueFlakeCount SnowcheckedConfig{..} = toInteger confCountBits * toInteger confTimeBits+{-# INLINE uniqueFlakeCount #-}
+ src/Data/Snowchecked/Encoding/ByteString.hs view
@@ -0,0 +1,26 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# 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.+-}++module Data.Snowchecked.Encoding.ByteString+	( module Data.Snowchecked.Encoding.Class+	) where++import           Data.ByteString+import           Data.ByteString.Lazy                      (fromStrict,+                                                            toStrict)+import           Data.Snowchecked.Encoding.ByteString.Lazy+import           Data.Snowchecked.Encoding.Class++instance IsFlake ByteString where+	fromFlake = toStrict . fromFlake+	{-# INLINE fromFlake #-}++	parseFish cfg bs = parseFish cfg $ fromStrict bs+	{-# INLINE parseFish #-}
+ src/Data/Snowchecked/Encoding/ByteString/Lazy.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -Wno-orphans      #-}+{-|+ - This module provides a conversion function between a+ - 'Flake' and a lazy 'ByteString'.+-}++module Data.Snowchecked.Encoding.ByteString.Lazy+	( module Data.Snowchecked.Encoding.Class+	) where++import           Data.ByteString.Lazy+import           Data.Snowchecked.Encoding.Class+import           Data.Snowchecked.Encoding.Integral ()+import           Data.Snowchecked.Internal.Import+import           Prelude                            hiding (foldr)++integerToBS :: Integer -> ByteString+integerToBS = pack . mkBytes+	where+		mkBytes 0 = mempty+		mkBytes n+			= fromIntegral n+			: mkBytes (n `shiftR` 8)+{-# INLINE integerToBS #-}++bsToInteger :: ByteString -> Integer+bsToInteger = foldr mkInteger 0+	where+		mkInteger :: Word8 -> Integer -> Integer+		mkInteger nxt memo = memo `shiftL` 8 .|. toInteger nxt+{-# INLINE bsToInteger #-}++instance IsFlake ByteString where+	fromFlake = integerToBS . fromFlake+	{-# INLINE fromFlake #-}++	parseFish cfg = parseFish cfg . bsToInteger+	{-# INLINE parseFish #-}
+ src/Data/Snowchecked/Encoding/Class.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE RecordWildCards #-}++module Data.Snowchecked.Encoding.Class ( IsFlake(..), Flakeish(..), goodFish ) where++import           Data.Snowchecked.Internal.Import++{-| Something that might be a 'Flake'.  The fields might not be truncated+ - to the appropriate size.+ -}+data Flakeish = Flakeish+	{ fishNodeId    ::  Word256+	, fishCount     ::  Word256+	, fishTime      ::  Word256+	, fishCheck     ::  Word256+	}++{-| Is this 'Flakeish' valid under the given 'SnowcheckedConfig' settings? -}+goodFish :: SnowcheckedConfig -> Flakeish -> Bool+goodFish SnowcheckedConfig{..} Flakeish{..} =+		checkInteger == cutBits (nodeInteger + countInteger + timeInteger) confCheckBits+	where+		checkInteger = cutBits fishCheck confCheckBits+		nodeInteger = cutBits fishNodeId confNodeBits+		countInteger = cutBits fishCount confCountBits+		timeInteger = cutBits fishTime confTimeBits+{-# INLINEABLE goodFish #-}++{-| The class of things that can be generated from and to a 'Flake'.+ -}+class IsFlake a where+	{-# MINIMAL fromFlake, (parseFish | parseFlake) #-}+	fromFlake :: Flake -> a+	parseFlake :: (MonadFail m) => SnowcheckedConfig -> a -> m Flake+	parseFlake cfg@SnowcheckedConfig{..} a = parseFish cfg a >>= \fish@Flakeish{..} ->+		if goodFish cfg fish then+			return $ Flake+				{ flakeTime = cutBits fishTime confTimeBits+				, flakeCount = cutBits fishCount confCountBits+				, flakeNodeId = cutBits fishNodeId confNodeBits+				, flakeConfig = cfg+				}+		else+			fail "Checksum is incorrect for Snowchecked flake"++	parseFish :: (MonadFail m) => SnowcheckedConfig -> a -> m Flakeish+	parseFish cfg a = toFlakeish <$> parseFlake cfg a+		where+			toFlakeish Flake{..} = Flakeish+				{ fishTime = flakeTime+				, fishCount = flakeCount+				, fishNodeId = flakeNodeId+				, fishCheck = flakeTime + flakeCount + flakeNodeId+				}
+ src/Data/Snowchecked/Encoding/Integral.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE RecordWildCards      #-}+{-# 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.+-}++module Data.Snowchecked.Encoding.Integral+	( module Data.Snowchecked.Encoding.Class+	) where++import           Data.Snowchecked.Encoding.Class+import           Data.Snowchecked.Internal.Import++instance {-# INCOHERENT #-} (Integral a) => IsFlake a where+	fromFlake Flake{..} = fromInteger+			$   cutBits checkInteger checkBitsInteger+			.|. cutShiftBits nodeIdInteger nodeBitsInteger checkBitsInteger+			.|. cutShiftBits countInteger countBitsInteger (checkBitsInteger + nodeBitsInteger)+			.|. cutShiftBits timeInteger timeBitsInteger (checkBitsInteger + nodeBitsInteger + countBitsInteger)+		where+			SnowcheckedConfig{..} = flakeConfig+			checkBitsInteger = toInteger confCheckBits+			nodeBitsInteger = toInteger confNodeBits+			timeBitsInteger = toInteger confTimeBits+			countBitsInteger = toInteger confCountBits+			nodeIdInteger = toInteger flakeNodeId+			timeInteger = toInteger flakeTime+			countInteger = toInteger flakeCount+			checkInteger = nodeIdInteger + timeInteger + countInteger+	{-# INLINEABLE fromFlake #-}++	parseFish SnowcheckedConfig{..} i = 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+			n = toInteger i+			checkBitsInteger = toInteger confCheckBits+			nodeBitsInteger = toInteger confNodeBits+			timeBitsInteger = toInteger confTimeBits+			countBitsInteger = toInteger confCountBits+	{-# INLINE parseFish #-}
+ src/Data/Snowchecked/Internal/Import.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE BlockArguments   #-}+{-# LANGUAGE TypeApplications #-}+module Data.Snowchecked.Internal.Import+	( module Data.Snowchecked.Internal.Import+	, module Data.Snowchecked.Types+	, module Data.Bits+	, module Data.WideWord.Word256+	, module Data.Word+	, module Numeric+	) where++import           Data.Bits              (Bits, shiftL, shiftR, (.&.), (.|.))+import           Data.Snowchecked.Types+import           Data.WideWord.Word256+import           Data.Word+import           Numeric++cutBits :: (Num a, Bits a, Integral bitCount) => a -> bitCount -> a+cutBits n bits = n .&. ((1 `shiftL` fromIntegral bits) - 1)+{-# INLINE cutBits #-}++cutShiftBits :: (Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) => a -> cutBitCount -> shiftBitCount -> a+cutShiftBits n cutBitCount shiftBitCount = cutBits n cutBitCount `shiftL` fromIntegral shiftBitCount+{-# INLINE cutShiftBits #-}++shiftCutBits :: (Num a, Bits a, Integral cutBitCount, Integral shiftBitCount) => a -> shiftBitCount -> cutBitCount -> a+shiftCutBits n shiftBitCount = cutBits $ n `shiftR` fromIntegral shiftBitCount+{-# INLINE shiftCutBits #-}++toInt :: (Integral a) => a -> Int+toInt = fromIntegral @_ @Int+{-# INLINE toInt #-}++toWord8 :: (Integral a) => a -> Word8+toWord8 = fromIntegral @_ @Word8+{-# INLINE toWord8 #-}++toWord32 :: (Integral a) => a -> Word32+toWord32 = fromIntegral @_ @Word32+{-# INLINE toWord32 #-}
+ src/Data/Snowchecked/Types.hs view
@@ -0,0 +1,65 @@+{-# 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 much 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.+-}+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)++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+    }++{-| 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.+ -}+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.+ } deriving (Eq,Show,Generic)++instance NFData Flake
+ stack.yaml view
@@ -0,0 +1,66 @@+# This file was automatically generated by 'stack init'+#+# Some commonly used options have been documented as comments in this file.+# For advanced use and comprehensive documentation of the format, please see:+# https://docs.haskellstack.org/en/stable/yaml_configuration/++# Resolver to choose a 'specific' stackage snapshot or a compiler version.+# A snapshot resolver dictates the compiler version and the set of packages+# to be used for project dependencies. For example:+#+# resolver: lts-3.5+# resolver: nightly-2015-09-21+# resolver: ghc-7.10.2+#+# The location of a snapshot can be provided as a file or url. Stack assumes+# a snapshot provided as a file might change, whereas a url resource does not.+#+# resolver: ./custom-snapshot.yaml+# resolver: https://example.com/snapshots/2018-01-01.yaml+resolver: lts-18.5++# User packages to be built.+# Various formats can be used as shown in the example below.+#+# packages:+# - some-directory+# - https://example.com/foo/bar/baz-0.0.2.tar.gz+#   subdirs:+#   - auto-update+#   - wai+packages:+  - .+# Dependency packages to be pulled from upstream that are not in the resolver.+# These entries can reference officially published versions as well as+# forks / in-progress versions pinned to a git hash. For example:+#+# extra-deps:+# - acme-missiles-0.3+# - git: https://github.com/commercialhaskell/stack.git+#   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a+#+# extra-deps: []++# Override default flag values for local packages and extra-deps+# flags: {}++# Extra package databases containing global packages+# extra-package-dbs: []++# Control whether we use the GHC we find on the path+# system-ghc: true+#+# Require a specific version of stack, using version ranges+# require-stack-version: -any # Default+# require-stack-version: ">=2.7"+#+# Override the architecture used by stack, especially useful on Windows+# arch: i386+# arch: x86_64+#+# Extra directories used by stack for building+# extra-include-dirs: [/path/to/dir]+# extra-lib-dirs: [/path/to/dir]+#+# Allow a newer minor version of GHC than the snapshot specifies+# compiler-check: newer-minor
+ stack.yaml.lock view
@@ -0,0 +1,12 @@+# This file was autogenerated by Stack.+# You should not edit this file by hand.+# For more information, please see the documentation at:+#   https://docs.haskellstack.org/en/stable/lock_files++packages: []+snapshots:+- completed:+    size: 585817+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/18/5.yaml+    sha256: 22d24d0dacad9c1450b9a174c28d203f9bb482a2a8da9710a2f2a9f4afee2887+  original: lts-18.5
+ test/Spec.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE RecordWildCards  #-}+{-# LANGUAGE TemplateHaskell  #-}+{-# LANGUAGE TypeApplications #-}++import           Control.Monad          (unless, void)+import           Control.Monad.IO.Class (MonadIO)+import           Data.List              (nub)+import           Data.Snowchecked+import           Data.WideWord.Word256+import           Data.Word+import           Hedgehog+import qualified Hedgehog.Gen           as Gen+import           Hedgehog.Main          (defaultMain)+import qualified Hedgehog.Range         as Range++main :: IO ()+main = do+		recheck (Size 4) (Seed 14462958355020818941 14776761114051845121) prop_generatesUniqueValues+		recheck (Size 8) (Seed 11763301661976410488 14055395789257366631) prop_generatesUniqueValues+		recheck (Size 14) (Seed 6771904241892528611 8532317410904456029) prop_generatesUniqueValues+		recheck (Size 14) (Seed 4790609826115340731 8375105224114527375) prop_generatesUniqueValues+		defaultMain [ checkParallel $$(discover) ]++genWord8 :: (MonadGen m) => m Word8+genWord8 = Gen.word8 $ Range.linear (minBound @Word8) (maxBound @Word8)++genWord256 :: (MonadGen m) => m Word256+genWord256 = Gen.integral $ Range.linear (minBound @Word256) (maxBound @Word256)++genConfig :: (MonadGen m) => m SnowcheckedConfig+genConfig = SnowcheckedConfig+		<$> Gen.integral (Range.linear 2 (maxBound @Word8))+		<*> Gen.integral (Range.linear 2 (maxBound @Word8))+		<*> Gen.integral (Range.linear 2 (maxBound @Word8))+		<*> Gen.integral (Range.linear 2 (maxBound @Word8))++forAllFlake :: (MonadIO m) => PropertyT m Flake+forAllFlake = forAll genConfig >>= forAllFlake'++forAllFlake' :: (MonadIO m) => SnowcheckedConfig -> PropertyT m Flake+forAllFlake' cfg = do+	nodeId <- forAll genWord256+	newSnowcheckedGen cfg nodeId >>= nextFlake++prop_generatesUniqueValues :: Property+prop_generatesUniqueValues = property $ do+	lst <- forAll $ Gen.list (Range.linear 2 8192) (return ())+	cfg <- forAll genConfig+	unless ( uniqueFlakeCount cfg > toInteger (length lst) ) discard+	nodeId <- forAll genWord256+	flakeGen <- newSnowcheckedGen cfg nodeId+	resultLst <- mapM (\_ -> nextFlake flakeGen) lst+	resultLst === nub resultLst++prop_roundTripIntegral :: Property+prop_roundTripIntegral = property $ do+	cfg <- forAll genConfig+	flake <- forAllFlake' cfg+	result <- parseFlake cfg $ flakeToIntegral @Integer flake+	flake === result++prop_flakeCanBeNFed :: Property+prop_flakeCanBeNFed = property $ do+	flake <- forAllFlake+	void $ evalNF flake