{-# 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
  Certificate
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 :: ACertificate ByteString
aCert = Certificate -> ACertificate ByteString
annotateCert Certificate
cert

  Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Annotated ProtocolMagicId ByteString
-> ACertificate ByteString -> Bool
isValid Annotated ProtocolMagicId ByteString
Dummy.annotatedProtocolMagicId ACertificate ByteString
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
  Certificate
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
  VerificationKey
badDelegateVK <- GenT Identity VerificationKey -> PropertyT IO VerificationKey
forall (m :: * -> *) a.
(Monad m, Show a, HasCallStack) =>
Gen a -> PropertyT m a
forAll (GenT Identity VerificationKey -> PropertyT IO VerificationKey)
-> GenT Identity VerificationKey -> PropertyT IO VerificationKey
forall a b. (a -> b) -> a -> b
$ (VerificationKey -> Bool)
-> GenT Identity VerificationKey -> GenT Identity VerificationKey
forall (m :: * -> *) a.
(MonadGen m, GenBase m ~ Identity) =>
(a -> Bool) -> m a -> m a
Gen.filter (VerificationKey -> VerificationKey -> Bool
forall a. Eq a => a -> a -> Bool
/= Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
delegateVK Certificate
cert) GenT Identity VerificationKey
genVerificationKey

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

  Bool -> PropertyT IO ()
forall (m :: * -> *). (MonadTest m, HasCallStack) => Bool -> m ()
assert (Bool -> PropertyT IO ())
-> (Bool -> Bool) -> Bool -> PropertyT IO ()
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
. Bool -> Bool
not (Bool -> PropertyT IO ()) -> Bool -> PropertyT IO ()
forall a b. (a -> b) -> a -> b
$ Annotated ProtocolMagicId ByteString
-> ACertificate ByteString -> Bool
isValid Annotated ProtocolMagicId ByteString
Dummy.annotatedProtocolMagicId ACertificate ByteString
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 (ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (ByteSpan -> ByteString) -> 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
. ByteString -> ByteSpan -> ByteString
slice ByteString
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
-> ByteString -> Either DecoderError (ACertificate ByteSpan)
forall a.
DecCBOR a =>
Version -> ByteString -> Either DecoderError a
decodeFull Version
byronProtVer ByteString
bytes
  where
    bytes :: ByteString
bytes = Version -> Certificate -> ByteString
forall a. EncCBOR a => Version -> a -> ByteString
serialize Version
byronProtVer Certificate
cert