{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Crypto.CBOR (
  constantByteString,
  getBytes,
  tests,
) where

import Cardano.Crypto (
  AbstractHash,
  PassPhrase,
  ProtocolMagicId (..),
  RedeemSignature,
  SignTag (SignForTestingOnly),
  Signature,
  SigningKey (..),
  VerificationKey (..),
  redeemDeterministicKeyGen,
  redeemSign,
  serializeCborHash,
  sign,
 )
import Cardano.Crypto.Wallet (xprv, xpub)
import Cardano.Ledger.Binary (Dropper, EncCBOR, dropBytes, dropList, enforceSize)
import Cardano.Prelude
import Crypto.Hash (Blake2b_224, Blake2b_256, Blake2b_384, Blake2b_512, SHA1)
import qualified Data.ByteArray as ByteArray
import qualified Data.ByteString as BS
import Hedgehog (Gen, Property)
import qualified Hedgehog as H
import Test.Cardano.Crypto.Gen
import Test.Cardano.Ledger.Binary.Vintage.Helpers (SizeTestConfig (..), scfg, sizeTest)
import Test.Cardano.Ledger.Binary.Vintage.Helpers.GoldenRoundTrip (
  deprecatedGoldenDecode,
  goldenTestCBOR,
  roundTripsCBORBuildable,
  roundTripsCBORShow,
 )
import Test.Cardano.Prelude

--------------------------------------------------------------------------------
-- ProtocolMagic
--------------------------------------------------------------------------------

roundTripProtocolMagicAeson :: Property
roundTripProtocolMagicAeson :: Property
roundTripProtocolMagicAeson = TestLimit
-> Gen ProtocolMagic
-> (ProtocolMagic -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen ProtocolMagic
genProtocolMagic ProtocolMagic -> PropertyT IO ()
forall a (m :: * -> *).
(Eq a, MonadTest m, ToJSON a, FromJSON a, Show a) =>
a -> m ()
roundTripsAesonShow

--------------------------------------------------------------------------------
-- RequiresNetworkMagic
--------------------------------------------------------------------------------

roundTripRequiresNetworkMagicCBOR :: Property
roundTripRequiresNetworkMagicCBOR :: Property
roundTripRequiresNetworkMagicCBOR =
  TestLimit
-> Gen RequiresNetworkMagic
-> (RequiresNetworkMagic -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
100 Gen RequiresNetworkMagic
genRequiresNetworkMagic RequiresNetworkMagic -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- VerificationKey
--------------------------------------------------------------------------------

goldenVerificationKey :: Property
goldenVerificationKey :: Property
goldenVerificationKey = VerificationKey -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR VerificationKey
vkey FilePath
"golden/VerificationKey"
  where
    Right VerificationKey
vkey = XPub -> VerificationKey
VerificationKey (XPub -> VerificationKey)
-> Either FilePath XPub -> Either FilePath VerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either FilePath XPub
xpub (Int -> Int -> ByteString
getBytes Int
0 Int
64)

roundTripVerificationKeyCBOR :: Property
roundTripVerificationKeyCBOR :: Property
roundTripVerificationKeyCBOR = 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 VerificationKey -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

roundTripVerificationKeyAeson :: Property
roundTripVerificationKeyAeson :: Property
roundTripVerificationKeyAeson = 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 VerificationKey -> PropertyT IO ()
forall a (m :: * -> *).
(Eq a, MonadTest m, ToJSON a, FromJSON a, Buildable a) =>
a -> m ()
roundTripsAesonBuildable

--------------------------------------------------------------------------------
-- VerificationKey
--------------------------------------------------------------------------------

roundTripCompactRedeemVerificationKeyCBOR :: Property
roundTripCompactRedeemVerificationKeyCBOR :: Property
roundTripCompactRedeemVerificationKeyCBOR = TestLimit
-> Gen CompactRedeemVerificationKey
-> (CompactRedeemVerificationKey -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen CompactRedeemVerificationKey
genCompactRedeemVerificationKey CompactRedeemVerificationKey -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Show a, HasCallStack) =>
a -> m ()
roundTripsCBORShow

--------------------------------------------------------------------------------
-- SigningKey
--------------------------------------------------------------------------------

goldenSigningKey :: Property
goldenSigningKey :: Property
goldenSigningKey = SigningKey -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR SigningKey
skey FilePath
"golden/SigningKey"
  where
    Right SigningKey
skey = XPrv -> SigningKey
SigningKey (XPrv -> SigningKey)
-> Either FilePath XPrv -> Either FilePath SigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either FilePath XPrv
forall bin. ByteArrayAccess bin => bin -> Either FilePath XPrv
xprv (Int -> Int -> ByteString
getBytes Int
10 Int
128)

roundTripSigningKeyCBOR :: Property
roundTripSigningKeyCBOR :: Property
roundTripSigningKeyCBOR = TestLimit
-> Gen SigningKey -> (SigningKey -> PropertyT IO ()) -> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen SigningKey
genSigningKey SigningKey -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- Signature
--------------------------------------------------------------------------------

goldenSignature :: Property
goldenSignature :: Property
goldenSignature = Signature () -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR Signature ()
sig FilePath
"golden/Signature"
  where
    Right SigningKey
skey = XPrv -> SigningKey
SigningKey (XPrv -> SigningKey)
-> Either FilePath XPrv -> Either FilePath SigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either FilePath XPrv
forall bin. ByteArrayAccess bin => bin -> Either FilePath XPrv
xprv (Int -> Int -> ByteString
getBytes Int
10 Int
128)
    sig :: Signature ()
sig = ProtocolMagicId -> SignTag -> SigningKey -> () -> Signature ()
forall a.
EncCBOR a =>
ProtocolMagicId -> SignTag -> SigningKey -> a -> Signature a
sign (Word32 -> ProtocolMagicId
ProtocolMagicId Word32
0) SignTag
SignForTestingOnly SigningKey
skey ()

genUnitSignature :: Gen (Signature ())
genUnitSignature :: Gen (Signature ())
genUnitSignature = do
  ProtocolMagicId
pm <- Gen ProtocolMagicId
genProtocolMagicId
  ProtocolMagicId -> Gen () -> Gen (Signature ())
forall a.
EncCBOR a =>
ProtocolMagicId -> Gen a -> Gen (Signature a)
genSignature ProtocolMagicId
pm (() -> Gen ()
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

roundTripSignatureCBOR :: Property
roundTripSignatureCBOR :: Property
roundTripSignatureCBOR = TestLimit
-> Gen (Signature ())
-> (Signature () -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen (Signature ())
genUnitSignature Signature () -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

roundTripSignatureAeson :: Property
roundTripSignatureAeson :: Property
roundTripSignatureAeson = TestLimit
-> Gen (Signature ())
-> (Signature () -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen (Signature ())
genUnitSignature Signature () -> PropertyT IO ()
forall a (m :: * -> *).
(Eq a, MonadTest m, ToJSON a, FromJSON a, Buildable a) =>
a -> m ()
roundTripsAesonBuildable

--------------------------------------------------------------------------------
-- RedeemVerificationKey
--------------------------------------------------------------------------------

goldenRedeemVerificationKey :: Property
goldenRedeemVerificationKey :: Property
goldenRedeemVerificationKey = RedeemVerificationKey -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR RedeemVerificationKey
rvk FilePath
"golden/RedeemVerificationKey"
  where
    Just RedeemVerificationKey
rvk = (RedeemVerificationKey, RedeemSigningKey) -> RedeemVerificationKey
forall a b. (a, b) -> a
fst ((RedeemVerificationKey, RedeemSigningKey)
 -> RedeemVerificationKey)
-> Maybe (RedeemVerificationKey, RedeemSigningKey)
-> Maybe RedeemVerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (RedeemVerificationKey, RedeemSigningKey)
redeemDeterministicKeyGen (Int -> Int -> ByteString
getBytes Int
0 Int
32)

roundTripRedeemVerificationKeyCBOR :: Property
roundTripRedeemVerificationKeyCBOR :: Property
roundTripRedeemVerificationKeyCBOR =
  TestLimit
-> Gen RedeemVerificationKey
-> (RedeemVerificationKey -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen RedeemVerificationKey
genRedeemVerificationKey RedeemVerificationKey -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

roundTripRedeemVerificationKeyAeson :: Property
roundTripRedeemVerificationKeyAeson :: Property
roundTripRedeemVerificationKeyAeson =
  TestLimit
-> Gen RedeemVerificationKey
-> (RedeemVerificationKey -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen RedeemVerificationKey
genRedeemVerificationKey RedeemVerificationKey -> PropertyT IO ()
forall a (m :: * -> *).
(Eq a, MonadTest m, ToJSON a, FromJSON a, Buildable a) =>
a -> m ()
roundTripsAesonBuildable

--------------------------------------------------------------------------------
-- RedeemSigningKey
--------------------------------------------------------------------------------

goldenRedeemSigningKey :: Property
goldenRedeemSigningKey :: Property
goldenRedeemSigningKey = RedeemSigningKey -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR RedeemSigningKey
rsk FilePath
"golden/RedeemSigningKey"
  where
    Just RedeemSigningKey
rsk = (RedeemVerificationKey, RedeemSigningKey) -> RedeemSigningKey
forall a b. (a, b) -> b
snd ((RedeemVerificationKey, RedeemSigningKey) -> RedeemSigningKey)
-> Maybe (RedeemVerificationKey, RedeemSigningKey)
-> Maybe RedeemSigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (RedeemVerificationKey, RedeemSigningKey)
redeemDeterministicKeyGen (Int -> Int -> ByteString
getBytes Int
0 Int
32)

roundTripRedeemSigningKeyCBOR :: Property
roundTripRedeemSigningKeyCBOR :: Property
roundTripRedeemSigningKeyCBOR =
  TestLimit
-> Gen RedeemSigningKey
-> (RedeemSigningKey -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen RedeemSigningKey
genRedeemSigningKey RedeemSigningKey -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------
-- RedeemSignature
--------------------------------------------------------------------------------

goldenRedeemSignature :: Property
goldenRedeemSignature :: Property
goldenRedeemSignature = RedeemSignature () -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR RedeemSignature ()
rsig FilePath
"golden/RedeemSignature"
  where
    Just RedeemSigningKey
rsk = (RedeemVerificationKey, RedeemSigningKey) -> RedeemSigningKey
forall a b. (a, b) -> b
snd ((RedeemVerificationKey, RedeemSigningKey) -> RedeemSigningKey)
-> Maybe (RedeemVerificationKey, RedeemSigningKey)
-> Maybe RedeemSigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Maybe (RedeemVerificationKey, RedeemSigningKey)
redeemDeterministicKeyGen (Int -> Int -> ByteString
getBytes Int
0 Int
32)
    rsig :: RedeemSignature ()
rsig = ProtocolMagicId
-> SignTag -> RedeemSigningKey -> () -> RedeemSignature ()
forall a.
EncCBOR a =>
ProtocolMagicId
-> SignTag -> RedeemSigningKey -> a -> RedeemSignature a
redeemSign (Word32 -> ProtocolMagicId
ProtocolMagicId Word32
0) SignTag
SignForTestingOnly RedeemSigningKey
rsk ()

genUnitRedeemSignature :: Gen (RedeemSignature ())
genUnitRedeemSignature :: Gen (RedeemSignature ())
genUnitRedeemSignature = do
  ProtocolMagicId
pm <- Gen ProtocolMagicId
genProtocolMagicId
  ProtocolMagicId -> Gen () -> Gen (RedeemSignature ())
forall a.
EncCBOR a =>
ProtocolMagicId -> Gen a -> Gen (RedeemSignature a)
genRedeemSignature ProtocolMagicId
pm (() -> Gen ()
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

roundTripRedeemSignatureCBOR :: Property
roundTripRedeemSignatureCBOR :: Property
roundTripRedeemSignatureCBOR =
  TestLimit
-> Gen (RedeemSignature ())
-> (RedeemSignature () -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen (RedeemSignature ())
genUnitRedeemSignature RedeemSignature () -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

roundTripRedeemSignatureAeson :: Property
roundTripRedeemSignatureAeson :: Property
roundTripRedeemSignatureAeson =
  TestLimit
-> Gen (RedeemSignature ())
-> (RedeemSignature () -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen (RedeemSignature ())
genUnitRedeemSignature RedeemSignature () -> PropertyT IO ()
forall a (m :: * -> *).
(Eq a, MonadTest m, ToJSON a, FromJSON a, Buildable a) =>
a -> m ()
roundTripsAesonBuildable

--------------------------------------------------------------------------------
-- VssPublicKey
--------------------------------------------------------------------------------

goldenDeprecatedVssPublicKey :: Property
goldenDeprecatedVssPublicKey :: Property
goldenDeprecatedVssPublicKey =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"VssPublicKey" Dropper s
forall s. Decoder s ()
dropBytes FilePath
"golden/VssPublicKey"

--------------------------------------------------------------------------------
-- DecShare
--------------------------------------------------------------------------------

goldenDeprecatedDecShare :: Property
goldenDeprecatedDecShare :: Property
goldenDeprecatedDecShare =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"DecShare" Dropper s
forall s. Decoder s ()
dropBytes FilePath
"golden/DecShare"

--------------------------------------------------------------------------------
-- EncShare
--------------------------------------------------------------------------------

goldenDeprecatedEncShare :: Property
goldenDeprecatedEncShare :: Property
goldenDeprecatedEncShare =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"EncShare" Dropper s
forall s. Decoder s ()
dropBytes FilePath
"golden/EncShare"

--------------------------------------------------------------------------------
-- Secret
--------------------------------------------------------------------------------

goldenDeprecatedSecret :: Property
goldenDeprecatedSecret :: Property
goldenDeprecatedSecret =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode Text
"Secret" Dropper s
forall s. Decoder s ()
dropBytes FilePath
"golden/Secret"

--------------------------------------------------------------------------------
-- SecretProof
--------------------------------------------------------------------------------

goldenDeprecatedSecretProof :: Property
goldenDeprecatedSecretProof :: Property
goldenDeprecatedSecretProof =
  HasCallStack =>
Text -> (forall s. Decoder s ()) -> FilePath -> Property
Text -> (forall s. Decoder s ()) -> FilePath -> Property
deprecatedGoldenDecode
    Text
"SecretProof"
    Dropper s
forall s. Decoder s ()
dropSecretProof
    FilePath
"golden/SecretProof"
  where
    dropSecretProof :: Dropper s
    dropSecretProof :: forall s. Decoder s ()
dropSecretProof = do
      Text -> Int -> Dropper s
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"SecretProof" Int
4
      Int -> Dropper s -> Dropper s
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
3 Dropper s
forall s. Decoder s ()
dropBytes
      Dropper s -> Dropper s
forall s. Dropper s -> Dropper s
dropList Dropper s
forall s. Decoder s ()
dropBytes

--------------------------------------------------------------------------------
-- AbstractHash
--------------------------------------------------------------------------------

goldenAbstractHash :: Property
goldenAbstractHash :: Property
goldenAbstractHash = AbstractHash Blake2b_256 () -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR (() -> AbstractHash Blake2b_256 ()
forall a. EncCBOR a => a -> Hash a
serializeCborHash ()) FilePath
"golden/AbstractHash"

genUnitAbstractHash :: Gen (AbstractHash Blake2b_256 ())
genUnitAbstractHash :: Gen (AbstractHash Blake2b_256 ())
genUnitAbstractHash = Gen () -> Gen (AbstractHash Blake2b_256 ())
forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash (Gen () -> Gen (AbstractHash Blake2b_256 ()))
-> Gen () -> Gen (AbstractHash Blake2b_256 ())
forall a b. (a -> b) -> a -> b
$ () -> Gen ()
forall a. a -> GenT Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

roundTripAbstractHashCBOR :: Property
roundTripAbstractHashCBOR :: Property
roundTripAbstractHashCBOR =
  TestLimit
-> Gen (AbstractHash Blake2b_256 ())
-> (AbstractHash Blake2b_256 () -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen (AbstractHash Blake2b_256 ())
genUnitAbstractHash AbstractHash Blake2b_256 () -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

roundTripAbstractHashAeson :: Property
roundTripAbstractHashAeson :: Property
roundTripAbstractHashAeson =
  TestLimit
-> Gen (AbstractHash Blake2b_256 ())
-> (AbstractHash Blake2b_256 () -> PropertyT IO ())
-> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen (AbstractHash Blake2b_256 ())
genUnitAbstractHash AbstractHash Blake2b_256 () -> PropertyT IO ()
forall a (m :: * -> *).
(Eq a, MonadTest m, ToJSON a, FromJSON a, Buildable a) =>
a -> m ()
roundTripsAesonBuildable

--------------------------------------------------------------------------------
-- PassPhrase
--------------------------------------------------------------------------------

goldenPassPhrase :: Property
goldenPassPhrase :: Property
goldenPassPhrase = PassPhrase -> FilePath -> Property
forall a.
(DecCBOR a, EncCBOR a, Eq a, Show a, HasCallStack) =>
a -> FilePath -> Property
goldenTestCBOR PassPhrase
passphrase FilePath
"golden/PassPhrase"
  where
    -- PassPhrase has to be 32 bytes in length
    passphrase :: PassPhrase
passphrase = [Word8] -> PassPhrase
forall a. ByteArray a => [Word8] -> a
ByteArray.pack (ByteString -> [Word8]
BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
forall a b. (a -> b) -> a -> b
$ Int -> Int -> ByteString
getBytes Int
3 Int
32) :: PassPhrase

roundTripPassPhraseCBOR :: Property
roundTripPassPhraseCBOR :: Property
roundTripPassPhraseCBOR = TestLimit
-> Gen PassPhrase -> (PassPhrase -> PropertyT IO ()) -> Property
forall a.
(Show a, HasCallStack) =>
TestLimit -> Gen a -> (a -> PropertyT IO ()) -> Property
eachOf TestLimit
1000 Gen PassPhrase
genPassPhrase PassPhrase -> PropertyT IO ()
forall a (m :: * -> *).
(DecCBOR a, EncCBOR a, Eq a, MonadTest m, Buildable a,
 HasCallStack) =>
a -> m ()
roundTripsCBORBuildable

--------------------------------------------------------------------------------

getBytes :: Int -> Int -> ByteString
getBytes :: Int -> Int -> ByteString
getBytes Int
offset Int
len = Int -> ByteString -> ByteString
BS.take Int
len (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop Int
offset ByteString
constantByteString

-- | Changing existing values in this string will break existing golden
-- tests, but it us OK to append more data to the end.
constantByteString :: ByteString
constantByteString :: ByteString
constantByteString =
  ByteString
"Kmyw4lDSE5S4fSH6etNouiXezCyEjKc3tG4ja0kFjO8qzai26ZMPUEJfEy15ox5kJ0uKD\
  \bi7i6dLXkuesVZ9JfHgjrctsLFt2NvovXnchsOvX05Y6LohlTNt5mkPFhUoXu1EZSJTIy\
  \3fTU53b412r4AEusD7tcdRgH47yTr5hMO63bJnYBbmNperLHfiT1lP0MLQLh1J1DfoYBs\
  \auoJOzvtAgvjHo6UFttnK6vZ3Cknpuob6uMS2MkJKmuoQsqsAYcRDWbJ2Rgw4bm2ndTM4\
  \zFfuRDKvdrL6sDkuPNPYqxMWlqnXjSbU0eLtceZuKgXLHR8cdvsEvywt4JaZUQhnbq3Vl\
  \7nZqcXdoi4XGTCgSGcGp8N0SDVhvkVh0QF1RVpWPnOMyYISJvuaHfo1zXMdq9tEdtJfID"

--------------------------------------------------------------------------------

sizeEstimates :: H.Group
sizeEstimates :: Group
sizeEstimates =
  let testPrecise :: forall a. (Show a, EncCBOR a) => Gen a -> Property
      testPrecise :: forall a. (Show a, EncCBOR a) => Gen a -> Property
testPrecise Gen a
g = SizeTestConfig a -> Property
forall a. EncCBOR a => SizeTestConfig a -> Property
sizeTest (SizeTestConfig a -> Property) -> SizeTestConfig a -> Property
forall a b. (a -> b) -> a -> b
$ SizeTestConfig a
forall a. Show a => SizeTestConfig a
scfg {gen = g, precise = True}
   in GroupName -> [(PropertyName, Property)] -> Group
H.Group
        GroupName
"Encoded size bounds for crypto types."
        [ (PropertyName
"VerificationKey", Gen VerificationKey -> Property
forall a. (Show a, EncCBOR a) => Gen a -> Property
testPrecise Gen VerificationKey
genVerificationKey)
        ,
          ( PropertyName
"AbstractHash Blake2b_224 VerificationKey"
          , forall a. (Show a, EncCBOR a) => Gen a -> Property
testPrecise @(AbstractHash Blake2b_224 VerificationKey)
              (Gen (AbstractHash Blake2b_224 VerificationKey) -> Property)
-> Gen (AbstractHash Blake2b_224 VerificationKey) -> Property
forall a b. (a -> b) -> a -> b
$ Gen VerificationKey
-> Gen (AbstractHash Blake2b_224 VerificationKey)
forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash Gen VerificationKey
genVerificationKey
          )
        ,
          ( PropertyName
"AbstractHash Blake2b_256 VerificationKey"
          , forall a. (Show a, EncCBOR a) => Gen a -> Property
testPrecise @(AbstractHash Blake2b_256 VerificationKey)
              (Gen (AbstractHash Blake2b_256 VerificationKey) -> Property)
-> Gen (AbstractHash Blake2b_256 VerificationKey) -> Property
forall a b. (a -> b) -> a -> b
$ Gen VerificationKey
-> Gen (AbstractHash Blake2b_256 VerificationKey)
forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash Gen VerificationKey
genVerificationKey
          )
        ,
          ( PropertyName
"AbstractHash Blake2b_384 VerificationKey"
          , forall a. (Show a, EncCBOR a) => Gen a -> Property
testPrecise @(AbstractHash Blake2b_384 VerificationKey)
              (Gen (AbstractHash Blake2b_384 VerificationKey) -> Property)
-> Gen (AbstractHash Blake2b_384 VerificationKey) -> Property
forall a b. (a -> b) -> a -> b
$ Gen VerificationKey
-> Gen (AbstractHash Blake2b_384 VerificationKey)
forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash Gen VerificationKey
genVerificationKey
          )
        ,
          ( PropertyName
"AbstractHash Blake2b_512 VerificationKey"
          , forall a. (Show a, EncCBOR a) => Gen a -> Property
testPrecise @(AbstractHash Blake2b_512 VerificationKey)
              (Gen (AbstractHash Blake2b_512 VerificationKey) -> Property)
-> Gen (AbstractHash Blake2b_512 VerificationKey) -> Property
forall a b. (a -> b) -> a -> b
$ Gen VerificationKey
-> Gen (AbstractHash Blake2b_512 VerificationKey)
forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash Gen VerificationKey
genVerificationKey
          )
        ,
          ( PropertyName
"AbstractHash SHA1 VerificationKey"
          , forall a. (Show a, EncCBOR a) => Gen a -> Property
testPrecise @(AbstractHash SHA1 VerificationKey)
              (Gen (AbstractHash SHA1 VerificationKey) -> Property)
-> Gen (AbstractHash SHA1 VerificationKey) -> Property
forall a b. (a -> b) -> a -> b
$ Gen VerificationKey -> Gen (AbstractHash SHA1 VerificationKey)
forall a algo.
(EncCBOR a, HashAlgorithm algo) =>
Gen a -> Gen (AbstractHash algo a)
genAbstractHash Gen VerificationKey
genVerificationKey
          )
        , (PropertyName
"RedeemVerificationKey", Gen RedeemVerificationKey -> Property
forall a. (Show a, EncCBOR a) => Gen a -> Property
testPrecise Gen RedeemVerificationKey
genRedeemVerificationKey)
        , (PropertyName
"RedeemSigningKey", Gen RedeemSigningKey -> Property
forall a. (Show a, EncCBOR a) => Gen a -> Property
testPrecise Gen RedeemSigningKey
genRedeemSigningKey)
        ,
          ( PropertyName
"RedeemSignature VerificationKey"
          , Gen (RedeemSignature VerificationKey) -> Property
forall a. (Show a, EncCBOR a) => Gen a -> Property
testPrecise (ProtocolMagicId
-> Gen VerificationKey -> Gen (RedeemSignature VerificationKey)
forall a.
EncCBOR a =>
ProtocolMagicId -> Gen a -> Gen (RedeemSignature a)
genRedeemSignature (Word32 -> ProtocolMagicId
ProtocolMagicId Word32
0) Gen VerificationKey
genVerificationKey)
          )
        ]

--------------------------------------------------------------------------------

tests :: IO Bool
tests :: IO Bool
tests =
  [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
and
    ([Bool] -> Bool) -> IO [Bool] -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [IO Bool] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
      [ Group -> IO Bool
forall (m :: * -> *). MonadIO m => Group -> m Bool
H.checkSequential $$FilePath
[(PropertyName, Property)]
Property
FilePath -> GroupName
FilePath -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
goldenVerificationKey :: Property
goldenSigningKey :: Property
goldenSignature :: Property
goldenRedeemVerificationKey :: Property
goldenRedeemSigningKey :: Property
goldenRedeemSignature :: Property
goldenDeprecatedVssPublicKey :: Property
goldenDeprecatedDecShare :: Property
goldenDeprecatedEncShare :: Property
goldenDeprecatedSecret :: Property
goldenDeprecatedSecretProof :: Property
goldenAbstractHash :: Property
goldenPassPhrase :: Property
discoverGolden
      , Group -> IO Bool
forall (m :: * -> *). MonadIO m => Group -> m Bool
H.checkParallel $$FilePath
[(PropertyName, Property)]
Property
FilePath -> GroupName
FilePath -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
roundTripProtocolMagicAeson :: Property
roundTripRequiresNetworkMagicCBOR :: Property
roundTripVerificationKeyCBOR :: Property
roundTripVerificationKeyAeson :: Property
roundTripCompactRedeemVerificationKeyCBOR :: Property
roundTripSigningKeyCBOR :: Property
roundTripSignatureCBOR :: Property
roundTripSignatureAeson :: Property
roundTripRedeemVerificationKeyCBOR :: Property
roundTripRedeemVerificationKeyAeson :: Property
roundTripRedeemSigningKeyCBOR :: Property
roundTripRedeemSignatureCBOR :: Property
roundTripRedeemSignatureAeson :: Property
roundTripAbstractHashCBOR :: Property
roundTripAbstractHashAeson :: Property
roundTripPassPhraseCBOR :: Property
discoverRoundTrip
      , Group -> IO Bool
forall (m :: * -> *). MonadIO m => Group -> m Bool
H.checkParallel Group
sizeEstimates
      ]