{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Test.Cardano.Chain.Delegation.Certificate (
  tests,
) where

import Cardano.Chain.Delegation (
  ACertificate (delegateVK),
  Certificate,
  isValid,
  signCertificate,
 )
import Cardano.Ledger.Binary (byronProtVer, decodeFull, serialize, slice)
import Cardano.Prelude
import qualified Data.ByteString.Lazy as BSL
import Hedgehog (Group, Property, assert, discover, forAll, property)
import qualified Hedgehog.Gen as Gen
import Test.Cardano.Chain.Slotting.Gen (genEpochNumber)
import qualified Test.Cardano.Crypto.Dummy as Dummy
import Test.Cardano.Crypto.Gen (genSafeSigner, genVerificationKey)

--------------------------------------------------------------------------------
-- Test Group
--------------------------------------------------------------------------------

tests :: Group
tests :: Group
tests = $$String
[(PropertyName, Property)]
Property
String -> GroupName
String -> PropertyName
GroupName -> [(PropertyName, Property)] -> Group
prop_certificateCorrect :: Property
prop_certificateIncorrect :: Property
discover

--------------------------------------------------------------------------------
-- Certificate Properties
--------------------------------------------------------------------------------

-- | Can validate 'Certificate's produced by 'signCertificate'
prop_certificateCorrect :: Property
prop_certificateCorrect :: Property
prop_certificateCorrect = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  cert <-
    Gen Certificate -> PropertyT IO Certificate
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      (Gen Certificate -> PropertyT IO Certificate)
-> Gen Certificate -> PropertyT IO Certificate
forall a b. (a -> b) -> a -> b
$ ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
signCertificate ProtocolMagicId
Dummy.protocolMagicId
      (VerificationKey -> EpochNumber -> SafeSigner -> Certificate)
-> GenT Identity VerificationKey
-> GenT Identity (EpochNumber -> SafeSigner -> Certificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity VerificationKey
genVerificationKey
      GenT Identity (EpochNumber -> SafeSigner -> Certificate)
-> GenT Identity EpochNumber
-> GenT Identity (SafeSigner -> Certificate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity EpochNumber
genEpochNumber
      GenT Identity (SafeSigner -> Certificate)
-> GenT Identity SafeSigner -> Gen Certificate
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SafeSigner
genSafeSigner

  let aCert = Certificate -> ACertificate ByteString
annotateCert Certificate
cert

  assert $ isValid Dummy.annotatedProtocolMagicId aCert

-- | Cannot validate 'Certificate's with incorrect verification keys
prop_certificateIncorrect :: Property
prop_certificateIncorrect :: Property
prop_certificateIncorrect = HasCallStack => PropertyT IO () -> Property
PropertyT IO () -> Property
property (PropertyT IO () -> Property) -> PropertyT IO () -> Property
forall a b. (a -> b) -> a -> b
$ do
  cert <-
    Gen Certificate -> PropertyT IO Certificate
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll
      (Gen Certificate -> PropertyT IO Certificate)
-> Gen Certificate -> PropertyT IO Certificate
forall a b. (a -> b) -> a -> b
$ ProtocolMagicId
-> VerificationKey -> EpochNumber -> SafeSigner -> Certificate
signCertificate ProtocolMagicId
Dummy.protocolMagicId
      (VerificationKey -> EpochNumber -> SafeSigner -> Certificate)
-> GenT Identity VerificationKey
-> GenT Identity (EpochNumber -> SafeSigner -> Certificate)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenT Identity VerificationKey
genVerificationKey
      GenT Identity (EpochNumber -> SafeSigner -> Certificate)
-> GenT Identity EpochNumber
-> GenT Identity (SafeSigner -> Certificate)
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity EpochNumber
genEpochNumber
      GenT Identity (SafeSigner -> Certificate)
-> GenT Identity SafeSigner -> Gen Certificate
forall a b.
GenT Identity (a -> b) -> GenT Identity a -> GenT Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenT Identity SafeSigner
genSafeSigner
  badDelegateVK <- forAll $ Gen.filter (/= delegateVK cert) genVerificationKey

  let badCert = Certificate
cert {delegateVK = badDelegateVK}
      aBadCert = Certificate -> ACertificate ByteString
annotateCert Certificate
badCert

  assert . not $ isValid Dummy.annotatedProtocolMagicId aBadCert

annotateCert :: Certificate -> ACertificate ByteString
annotateCert :: Certificate -> ACertificate ByteString
annotateCert Certificate
cert =
  (ByteSpan -> ByteString)
-> ACertificate ByteSpan -> ACertificate ByteString
forall a b. (a -> b) -> ACertificate a -> ACertificate b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (LazyByteString -> ByteString
BSL.toStrict (LazyByteString -> ByteString)
-> (ByteSpan -> LazyByteString) -> ByteSpan -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. LazyByteString -> ByteSpan -> LazyByteString
slice LazyByteString
bytes)
    (ACertificate ByteSpan -> ACertificate ByteString)
-> (Either DecoderError (ACertificate ByteSpan)
    -> ACertificate ByteSpan)
-> Either DecoderError (ACertificate ByteSpan)
-> ACertificate ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ACertificate ByteSpan
-> Either DecoderError (ACertificate ByteSpan)
-> ACertificate ByteSpan
forall b a. b -> Either a b -> b
fromRight
      (Text -> ACertificate ByteSpan
forall a. HasCallStack => Text -> a
panic Text
"prop_certificateCorrect: Round trip broken for Certificate")
    (Either DecoderError (ACertificate ByteSpan)
 -> ACertificate ByteString)
-> Either DecoderError (ACertificate ByteSpan)
-> ACertificate ByteString
forall a b. (a -> b) -> a -> b
$ Version
-> LazyByteString -> Either DecoderError (ACertificate ByteSpan)
forall a.
DecCBOR a =>
Version -> LazyByteString -> Either DecoderError a
decodeFull Version
byronProtVer LazyByteString
bytes
  where
    bytes :: LazyByteString
bytes = Version -> Certificate -> LazyByteString
forall a. EncCBOR a => Version -> a -> LazyByteString
serialize Version
byronProtVer Certificate
cert