{-# 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 = Group -> IO Bool
forall (m :: * -> *). MonadIO m => Group -> m Bool
checkParallel $$String
[(PropertyName, Property)]
Property
String -> GroupName
String -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
prop_pubKeyLenLimited :: Property
prop_signatureLenLimited :: Property
prop_abstractHash224LenLimited :: Property
prop_abstractHash256LenLimited :: 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
(Limit t -> Limit t -> Bool)
-> (Limit t -> Limit t -> Bool) -> Eq (Limit t)
forall t. Limit t -> Limit t -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$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
Eq, Eq (Limit t)
Eq (Limit t) =>
(Limit t -> Limit t -> Ordering)
-> (Limit t -> Limit t -> Bool)
-> (Limit t -> Limit t -> Bool)
-> (Limit t -> Limit t -> Bool)
-> (Limit t -> Limit t -> Bool)
-> (Limit t -> Limit t -> Limit t)
-> (Limit t -> Limit t -> Limit t)
-> Ord (Limit t)
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
$ccompare :: forall t. Limit t -> Limit t -> Ordering
compare :: Limit t -> Limit t -> Ordering
$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
>= :: Limit t -> Limit t -> Bool
$cmax :: forall t. Limit t -> Limit t -> Limit t
max :: Limit t -> Limit t -> Limit t
$cmin :: forall t. Limit t -> Limit t -> Limit t
min :: Limit t -> Limit t -> Limit t
Ord, Int -> Limit t -> ShowS
[Limit t] -> ShowS
Limit t -> String
(Int -> Limit t -> ShowS)
-> (Limit t -> String) -> ([Limit t] -> ShowS) -> Show (Limit t)
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
$cshowsPrec :: forall t. Int -> Limit t -> ShowS
showsPrec :: Int -> Limit t -> ShowS
$cshow :: forall t. Limit t -> String
show :: Limit t -> String
$cshowList :: forall t. [Limit t] -> ShowS
showList :: [Limit t] -> ShowS
Show, Integer -> Limit t
Limit t -> Limit t
Limit t -> Limit t -> Limit t
(Limit t -> Limit t -> Limit t)
-> (Limit t -> Limit t -> Limit t)
-> (Limit t -> Limit t -> Limit t)
-> (Limit t -> Limit t)
-> (Limit t -> Limit t)
-> (Limit t -> Limit t)
-> (Integer -> Limit t)
-> Num (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
$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
* :: Limit t -> Limit t -> Limit t
$cnegate :: forall t. Limit t -> Limit t
negate :: Limit t -> Limit t
$cabs :: forall t. Limit t -> Limit t
abs :: Limit t -> Limit t
$csignum :: forall t. Limit t -> Limit t
signum :: Limit t -> Limit t
$cfromInteger :: forall t. Integer -> Limit t
fromInteger :: Integer -> 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]
(Limit t -> Limit t)
-> (Limit t -> Limit t)
-> (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 -> [Limit t])
-> Enum (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
$csucc :: forall t. Limit t -> Limit t
succ :: Limit t -> Limit t
$cpred :: forall t. Limit t -> Limit t
pred :: Limit t -> Limit t
$ctoEnum :: forall t. Int -> Limit t
toEnum :: Int -> Limit t
$cfromEnum :: forall t. Limit t -> Int
fromEnum :: Limit t -> Int
$cenumFrom :: forall t. Limit t -> [Limit t]
enumFrom :: Limit t -> [Limit t]
$cenumFromThen :: forall t. Limit t -> Limit t -> [Limit t]
enumFromThen :: Limit t -> Limit t -> [Limit t]
$cenumFromTo :: forall t. Limit t -> Limit t -> [Limit t]
enumFromTo :: Limit t -> Limit t -> [Limit t]
$cenumFromThenTo :: forall t. Limit t -> Limit t -> Limit t -> [Limit t]
enumFromThenTo :: Limit t -> Limit t -> Limit t -> [Limit t]
Enum, Num (Limit t)
Ord (Limit t)
(Num (Limit t), Ord (Limit t)) =>
(Limit t -> Rational) -> Real (Limit t)
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
$ctoRational :: forall t. Limit t -> Rational
toRational :: Limit t -> Rational
Real, Enum (Limit t)
Real (Limit t)
(Real (Limit t), Enum (Limit t)) =>
(Limit t -> Limit t -> Limit t)
-> (Limit t -> Limit t -> Limit t)
-> (Limit t -> Limit t -> Limit t)
-> (Limit t -> Limit t -> Limit t)
-> (Limit t -> Limit t -> (Limit t, Limit t))
-> (Limit t -> Limit t -> (Limit t, Limit t))
-> (Limit t -> Integer)
-> Integral (Limit t)
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
$cquot :: forall t. Limit t -> Limit t -> Limit t
quot :: Limit t -> Limit t -> Limit t
$crem :: forall t. Limit t -> Limit t -> Limit t
rem :: Limit t -> Limit t -> Limit t
$cdiv :: forall t. Limit t -> Limit t -> Limit t
div :: Limit t -> Limit t -> Limit t
$cmod :: forall t. Limit t -> Limit t -> Limit t
mod :: Limit t -> Limit t -> Limit t
$cquotRem :: forall t. Limit t -> Limit t -> (Limit t, Limit t)
quotRem :: Limit t -> Limit t -> (Limit t, Limit t)
$cdivMod :: forall t. Limit t -> Limit t -> (Limit t, Limit t)
divMod :: Limit t -> Limit t -> (Limit t, Limit t)
$ctoInteger :: forall t. Limit t -> Integer
toInteger :: Limit t -> Integer
Integral)

instance Functor Limit where
  fmap :: forall a b. (a -> b) -> Limit a -> Limit b
fmap a -> b
_ (Limit Word32
x) = Word32 -> Limit b
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 =
  Int -> Limit (AbstractHash algo a)
forall a b. (Integral a, Num b) => a -> b
fromIntegral (algo -> Int
forall a. HashAlgorithm a => a -> Int
hashDigestSize (Text -> algo
forall a. HasCallStack => Text -> a
panic Text
"AbstractHash limit" :: algo) Int -> Int -> Int
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 = XSignature -> Signature a
forall a. XSignature -> Signature a
Signature (XSignature -> Signature a)
-> Limit XSignature -> Limit (Signature a)
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 = TestLimit
-> Gen VerificationKey
-> (VerificationKey -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen VerificationKey
genVerificationKey (Limit VerificationKey -> VerificationKey -> PropertyT IO ()
forall a. EncCBOR a => Limit a -> a -> PropertyT IO ()
msgLenLimited Limit VerificationKey
mlVerificationKey)

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

prop_abstractHash224LenLimited :: Property
prop_abstractHash224LenLimited :: Property
prop_abstractHash224LenLimited =
  TestLimit
-> Gen (AbstractHash Blake2b_224 Int32)
-> (AbstractHash Blake2b_224 Int32 -> PropertyT IO ())
-> Property
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 (Range Int32 -> Gen Int32
forall (m :: * -> *). MonadGen m => Range Int32 -> m Int32
Gen.int32 Range Int32
forall a. (Bounded a, Num a) => Range a
Range.constantBounded))
    (Limit (AbstractHash Blake2b_224 Int32)
-> AbstractHash Blake2b_224 Int32 -> PropertyT IO ()
forall a. EncCBOR a => Limit a -> a -> PropertyT IO ()
msgLenLimited Limit (AbstractHash Blake2b_224 Int32)
forall algo a. HashAlgorithm algo => Limit (AbstractHash algo a)
mlAbstractHash)

prop_abstractHash256LenLimited :: Property
prop_abstractHash256LenLimited :: Property
prop_abstractHash256LenLimited =
  TestLimit
-> Gen (AbstractHash Blake2b_256 Int32)
-> (AbstractHash Blake2b_256 Int32 -> PropertyT IO ())
-> Property
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 (Range Int32 -> Gen Int32
forall (m :: * -> *). MonadGen m => Range Int32 -> m Int32
Gen.int32 Range Int32
forall a. (Bounded a, Num a) => Range a
Range.constantBounded))
    (Limit (AbstractHash Blake2b_256 Int32)
-> AbstractHash Blake2b_256 Int32 -> PropertyT IO ()
forall a. EncCBOR a => Limit a -> a -> PropertyT IO ()
msgLenLimited Limit (AbstractHash Blake2b_256 Int32)
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 = Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length (Version -> a -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize' Version
byronProtVer a
a) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Limit a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Limit a
limit