{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Crypto.Limits (
  tests,
)
where

import Cardano.Crypto (AbstractHash, Signature (..), VerificationKey)
import qualified Cardano.Crypto.Wallet as CC
import Cardano.Ledger.Binary (EncCBOR, byronProtVer, serialize')
import Cardano.Prelude
import Crypto.Hash (Blake2b_224, Blake2b_256)
import Crypto.Hash.IO (HashAlgorithm, hashDigestSize)
import qualified Data.ByteString as BS
import Hedgehog
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Cardano.Crypto.Gen (
  feedPM,
  genAbstractHash,
  genSignature,
  genVerificationKey,
 )
import Test.Cardano.Prelude

--------------------------------------------------------------------------------
-- Main Test Action
--------------------------------------------------------------------------------

tests :: IO Bool
tests :: IO Bool
tests = forall (m :: * -> *). MonadIO m => Group -> m Bool
checkParallel $$String
[(PropertyName, Property)]
Property
String -> PropertyName
String -> GroupName
GroupName -> [(PropertyName, Property)] -> Group
prop_abstractHash256LenLimited :: Property
prop_abstractHash224LenLimited :: Property
prop_signatureLenLimited :: Property
prop_pubKeyLenLimited :: Property
discover

---------------------------------------------------------------------------
-- Limit
---------------------------------------------------------------------------

-- | A limit on the length of something (in bytes).
--   TODO should check for overflow in the Num instance.
--   Although, if the limit is anywhere near maxBound :: Word32 then something
--   is almost certainly amiss.
newtype Limit t = Limit
  { forall t. Limit t -> Word32
getLimit :: Word32
  }
  deriving (Limit t -> Limit t -> Bool
forall t. Limit t -> Limit t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limit t -> Limit t -> Bool
$c/= :: forall t. Limit t -> Limit t -> Bool
== :: Limit t -> Limit t -> Bool
$c== :: forall t. Limit t -> Limit t -> Bool
Eq, Limit t -> Limit t -> Bool
Limit t -> Limit t -> Ordering
Limit t -> Limit t -> Limit t
forall t. Eq (Limit t)
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
forall t. Limit t -> Limit t -> Bool
forall t. Limit t -> Limit t -> Ordering
forall t. Limit t -> Limit t -> Limit t
min :: Limit t -> Limit t -> Limit t
$cmin :: forall t. Limit t -> Limit t -> Limit t
max :: Limit t -> Limit t -> Limit t
$cmax :: forall t. Limit t -> Limit t -> Limit t
>= :: Limit t -> Limit t -> Bool
$c>= :: forall t. Limit t -> Limit t -> Bool
> :: Limit t -> Limit t -> Bool
$c> :: forall t. Limit t -> Limit t -> Bool
<= :: Limit t -> Limit t -> Bool
$c<= :: forall t. Limit t -> Limit t -> Bool
< :: Limit t -> Limit t -> Bool
$c< :: forall t. Limit t -> Limit t -> Bool
compare :: Limit t -> Limit t -> Ordering
$ccompare :: forall t. Limit t -> Limit t -> Ordering
Ord, Int -> Limit t -> ShowS
forall t. Int -> Limit t -> ShowS
forall t. [Limit t] -> ShowS
forall t. Limit t -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit t] -> ShowS
$cshowList :: forall t. [Limit t] -> ShowS
show :: Limit t -> String
$cshow :: forall t. Limit t -> String
showsPrec :: Int -> Limit t -> ShowS
$cshowsPrec :: forall t. Int -> Limit t -> ShowS
Show, Integer -> Limit t
Limit t -> Limit t
Limit t -> Limit t -> Limit t
forall t. Integer -> Limit t
forall t. Limit t -> Limit t
forall t. Limit t -> Limit t -> Limit t
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Limit t
$cfromInteger :: forall t. Integer -> Limit t
signum :: Limit t -> Limit t
$csignum :: forall t. Limit t -> Limit t
abs :: Limit t -> Limit t
$cabs :: forall t. Limit t -> Limit t
negate :: Limit t -> Limit t
$cnegate :: forall t. Limit t -> Limit t
* :: Limit t -> Limit t -> Limit t
$c* :: forall t. Limit t -> Limit t -> Limit t
- :: Limit t -> Limit t -> Limit t
$c- :: forall t. Limit t -> Limit t -> Limit t
+ :: Limit t -> Limit t -> Limit t
$c+ :: forall t. Limit t -> Limit t -> Limit t
Num, Int -> Limit t
Limit t -> Int
Limit t -> [Limit t]
Limit t -> Limit t
Limit t -> Limit t -> [Limit t]
Limit t -> Limit t -> Limit t -> [Limit t]
forall t. Int -> Limit t
forall t. Limit t -> Int
forall t. Limit t -> [Limit t]
forall t. Limit t -> Limit t
forall t. Limit t -> Limit t -> [Limit t]
forall t. Limit t -> Limit t -> Limit t -> [Limit t]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Limit t -> Limit t -> Limit t -> [Limit t]
$cenumFromThenTo :: forall t. Limit t -> Limit t -> Limit t -> [Limit t]
enumFromTo :: Limit t -> Limit t -> [Limit t]
$cenumFromTo :: forall t. Limit t -> Limit t -> [Limit t]
enumFromThen :: Limit t -> Limit t -> [Limit t]
$cenumFromThen :: forall t. Limit t -> Limit t -> [Limit t]
enumFrom :: Limit t -> [Limit t]
$cenumFrom :: forall t. Limit t -> [Limit t]
fromEnum :: Limit t -> Int
$cfromEnum :: forall t. Limit t -> Int
toEnum :: Int -> Limit t
$ctoEnum :: forall t. Int -> Limit t
pred :: Limit t -> Limit t
$cpred :: forall t. Limit t -> Limit t
succ :: Limit t -> Limit t
$csucc :: forall t. Limit t -> Limit t
Enum, Limit t -> Rational
forall t. Num (Limit t)
forall t. Ord (Limit t)
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
forall t. Limit t -> Rational
toRational :: Limit t -> Rational
$ctoRational :: forall t. Limit t -> Rational
Real, Limit t -> Integer
Limit t -> Limit t -> (Limit t, Limit t)
Limit t -> Limit t -> Limit t
forall t. Enum (Limit t)
forall t. Real (Limit t)
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
forall t. Limit t -> Integer
forall t. Limit t -> Limit t -> (Limit t, Limit t)
forall t. Limit t -> Limit t -> Limit t
toInteger :: Limit t -> Integer
$ctoInteger :: forall t. Limit t -> Integer
divMod :: Limit t -> Limit t -> (Limit t, Limit t)
$cdivMod :: forall t. Limit t -> Limit t -> (Limit t, Limit t)
quotRem :: Limit t -> Limit t -> (Limit t, Limit t)
$cquotRem :: forall t. Limit t -> Limit t -> (Limit t, Limit t)
mod :: Limit t -> Limit t -> Limit t
$cmod :: forall t. Limit t -> Limit t -> Limit t
div :: Limit t -> Limit t -> Limit t
$cdiv :: forall t. Limit t -> Limit t -> Limit t
rem :: Limit t -> Limit t -> Limit t
$crem :: forall t. Limit t -> Limit t -> Limit t
quot :: Limit t -> Limit t -> Limit t
$cquot :: forall t. Limit t -> Limit t -> Limit t
Integral)

instance Functor Limit where
  fmap :: forall a b. (a -> b) -> Limit a -> Limit b
fmap a -> b
_ (Limit Word32
x) = forall t. Word32 -> Limit t
Limit Word32
x

--------------------------------------------------------------------------------
-- Helper Functions
--------------------------------------------------------------------------------

mlAbstractHash ::
  forall algo a. HashAlgorithm algo => Limit (AbstractHash algo a)
mlAbstractHash :: forall algo a. HashAlgorithm algo => Limit (AbstractHash algo a)
mlAbstractHash =
  forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. HashAlgorithm a => a -> Int
hashDigestSize (forall a. HasCallStack => Text -> a
panic Text
"AbstractHash limit" :: algo) forall a. Num a => a -> a -> a
+ Int
4)

mlVerificationKey :: Limit VerificationKey
mlVerificationKey :: Limit VerificationKey
mlVerificationKey = Limit VerificationKey
66

mlXSignature :: Limit CC.XSignature
mlXSignature :: Limit XSignature
mlXSignature = Limit XSignature
66

mlSignature :: Limit (Signature a)
mlSignature :: forall a. Limit (Signature a)
mlSignature = forall a. XSignature -> Signature a
Signature forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Limit XSignature
mlXSignature

--------------------------------------------------------------------------------
-- Message Length Properties
--------------------------------------------------------------------------------

prop_pubKeyLenLimited :: Property
prop_pubKeyLenLimited :: Property
prop_pubKeyLenLimited = forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen VerificationKey
genVerificationKey (forall a. EncCBOR a => Limit a -> a -> PropertyT IO ()
msgLenLimited Limit VerificationKey
mlVerificationKey)

prop_signatureLenLimited :: Property
prop_signatureLenLimited :: Property
prop_signatureLenLimited =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf
    TestLimit
1000
    (forall a. (ProtocolMagicId -> Gen a) -> Gen a
feedPM (\ProtocolMagicId
pm -> forall a.
EncCBOR a =>
ProtocolMagicId -> Gen a -> Gen (Signature a)
genSignature ProtocolMagicId
pm (forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (forall a. a -> a -> Range a
Range.constant Int
0 Int
1000) (forall (f :: * -> *) a. Applicative f => a -> f a
pure ()))))
    (forall a. EncCBOR a => Limit a -> a -> PropertyT IO ()
msgLenLimited forall a. Limit (Signature a)
mlSignature)

prop_abstractHash224LenLimited :: Property
prop_abstractHash224LenLimited :: Property
prop_abstractHash224LenLimited =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf
    TestLimit
1000
    (forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash @Int32 @Blake2b_224 (forall (m :: * -> *). MonadGen m => Range Int32 -> m Int32
Gen.int32 forall a. (Bounded a, Num a) => Range a
Range.constantBounded))
    (forall a. EncCBOR a => Limit a -> a -> PropertyT IO ()
msgLenLimited forall algo a. HashAlgorithm algo => Limit (AbstractHash algo a)
mlAbstractHash)

prop_abstractHash256LenLimited :: Property
prop_abstractHash256LenLimited :: Property
prop_abstractHash256LenLimited =
  forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf
    TestLimit
1000
    (forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash @Int32 @Blake2b_256 (forall (m :: * -> *). MonadGen m => Range Int32 -> m Int32
Gen.int32 forall a. (Bounded a, Num a) => Range a
Range.constantBounded))
    (forall a. EncCBOR a => Limit a -> a -> PropertyT IO ()
msgLenLimited forall algo a. HashAlgorithm algo => Limit (AbstractHash algo a)
mlAbstractHash)

msgLenLimited :: EncCBOR a => Limit a -> a -> PropertyT IO ()
msgLenLimited :: forall a. EncCBOR a => Limit a -> a -> PropertyT IO ()
msgLenLimited Limit a
limit a
a = forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length (forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer a
a) forall a. Ord a => a -> a -> Bool
<= forall a b. (Integral a, Num b) => a -> b
fromIntegral Limit a
limit