snowchecked-0.0.0.1: test/Spec.hs

{-# 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