{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- |
-- Module: Test.Target
-- Copyright: Copyright © 2021 Kadena LLC.
-- License: MIT
-- Maintainer: Lars Kuhtz <lars@kadena.io>
-- Stability: experimental
--
-- TODO
--
module Test.Target
( tests
) where
import Control.Monad
import Data.Bits
import Data.Char
import Data.Either
import Data.String
import qualified Data.Text as T
import Data.Word
import Test.QuickCheck
import Test.Syd
import Text.Read
-- internal modules
import Target
import TestUtils
import Utils
-- -------------------------------------------------------------------------- --
-- Utils
instance Arbitrary Target where
arbitrary = Target . fromIntegral <$> chooseInteger (0, 2^256-1)
newtype TargetBit = TargetBit Int
deriving (Show, Eq, Ord)
instance Arbitrary TargetBit where
arbitrary = TargetBit <$> chooseInt (0, 255)
instance Arbitrary Level where
arbitrary = level <$> choose @Int (0, 255)
nibbleClz :: Char -> Int
nibbleClz = (\x -> x - 4) . countLeadingZeros . int @_ @Word8 . digitToInt
hexClz :: T.Text -> Int
hexClz hexStr = case T.uncons <$> T.break (/= '0') hexStr of
(a, Nothing) -> T.length a * 4
(a, Just (b, _)) -> T.length a * 4 + nibbleClz b
-- -------------------------------------------------------------------------- --
-- Tests
tests :: Spec
tests = describe "Target tests" $ do
prop "prop_json_encode_decode @Target" (prop_json_encode_decode @Target)
prop "prop_show_read @Target" (prop_show_read @Target)
prop "prop_targetWords" prop_targetWords
prop "prop_fromString" prop_fromString
prop "prop_targetLevel" prop_targetLevel
prop "prop_getTargetLevel" prop_getTargetLevel
prop "prop_level_difficulty" prop_level_difficulty
test_level_difficulty
prop_read_empty
prop_read_wrong_size
prop_read_size
-- -------------------------------------------------------------------------- --
-- Properties
prop_read_empty :: Spec
prop_read_empty = describe "target from empty string fails" $
prop "read empty string fails" $ isLeft $ readEither @Target $ targetString ""
prop_read_wrong_size :: Spec
prop_read_wrong_size = describe "read target of wrong size fails" $ do
forM_ ([0..31] <> [33..40]) $ \s ->
prop "read string of wrong size failes"
$ fmap (isLeft . readEither @Target . targetString)
$ vectorOf (s * 2)
$ elements "0123456789abcdef"
prop_read_size :: Spec
prop_read_size = prop "read string of correct size succeeds"
$ fmap (isRight . readEither @Target . targetString)
$ vectorOf (32 * 2)
$ elements "0123456789abcdef"
targetString :: String -> String
targetString s = "Target \"" <> s <> "\""
prop_targetWords :: Target -> Property
prop_targetWords t = targetFromWords (targetToWords t) === t
prop_fromString :: Target -> Property
prop_fromString t = (fromString $ T.unpack $ targetToText16Be t) === t
-- -------------------------------------------------------------------------- --
-- Level Stuff
prop_targetLevel :: Level -> Property
prop_targetLevel l =
level lzc === l
.&&.
T.all (== 'f') r === True
where
(lzc, r) = case T.uncons <$> T.break (/= '0') str of
(a, Nothing) -> (T.length a * 4, r)
(a, Just (b, c)) -> (T.length a * 4 + nibbleClz b , c)
str = targetToText16Be (mkTargetLevel l)
prop_getTargetLevel :: Target -> Property
prop_getTargetLevel t = getTargetLevel t === level (hexClz (targetToText16Be t))
prop_level_difficulty :: Level -> Property
prop_level_difficulty l = f l === l
where
f = getTargetLevel . difficultyToTarget . targetToDifficulty . mkTargetLevel
test_level_difficulty :: Spec
test_level_difficulty = describe "level is the log2 of difficulty" $
mapM_ (\x -> it (show x) $ f x `shouldBe` x) $ level <$> [0..256]
where
f = getTargetLevel . difficultyToTarget . targetToDifficulty . mkTargetLevel