Skip to content
Permalink
Browse files

Merge #547

547: [#348] Move ProxyVerificationKey to Delegation.Certificate r=ruhatch a=ruhatch

This moves the `ProxyVerificationKey` from `cardano-crypto-wrapper` into `cardano-ledger`, as it is only ever used as a `Delegation.Certificate`.

Closes #348 

Co-authored-by: Rupert Horlick <rupert.horlick@iohk.io>
  • Loading branch information...
iohk-bors and ruhatch committed Jun 12, 2019
2 parents 7f5263e + 1a6cef7 commit 808f8dfd9461665c11970e427f01b94fe9f514a4
Showing with 341 additions and 744 deletions.
  1. +2 −0 cardano-ledger/cardano-ledger.cabal
  2. +3 −5 cardano-ledger/src/Cardano/Chain/Block/Header.hs
  3. +174 −11 cardano-ledger/src/Cardano/Chain/Delegation/Certificate.hs
  4. +1 −2 cardano-ledger/src/Cardano/Chain/Delegation/Payload.hs
  5. +7 −9 cardano-ledger/src/Cardano/Chain/Delegation/Validation/Interface.hs
  6. +7 −11 cardano-ledger/src/Cardano/Chain/Delegation/Validation/Scheduling.hs
  7. +1 −54 cardano-ledger/src/Cardano/Chain/Genesis/Config.hs
  8. +20 −33 cardano-ledger/src/Cardano/Chain/Genesis/Delegation.hs
  9. +1 −2 cardano-ledger/src/Cardano/Chain/Genesis/Generate.hs
  10. +0 −4 cardano-ledger/src/Cardano/Chain/Genesis/Spec.hs
  11. +2 −3 cardano-ledger/test/Test/Cardano/Chain/Block/CBOR.hs
  12. +9 −4 cardano-ledger/test/Test/Cardano/Chain/Block/Gen.hs
  13. +1 −1 cardano-ledger/test/Test/Cardano/Chain/Delegation/CBOR.hs
  14. +73 −0 cardano-ledger/test/Test/Cardano/Chain/Delegation/Certificate.hs
  15. +3 −3 cardano-ledger/test/Test/Cardano/Chain/Delegation/Example.hs
  16. +12 −6 cardano-ledger/test/Test/Cardano/Chain/Delegation/Gen.hs
  17. +8 −13 cardano-ledger/test/Test/Cardano/Chain/Elaboration/Delegation.hs
  18. +3 −4 cardano-ledger/test/Test/Cardano/Chain/Genesis/Example.hs
  19. +1 −18 cardano-ledger/test/Test/Cardano/Chain/Genesis/Gen.hs
  20. +3 −41 cardano-ledger/test/Test/Cardano/Chain/Genesis/Json.hs
  21. 0 cardano-ledger/test/golden/cbor/delegation/{ProxyVKHeavy → Certificate}
  22. +0 −1 cardano-ledger/test/golden/cbor/delegation/HeavyDlgIndex
  23. +0 −17 cardano-ledger/test/golden/cbor/delegation/ProxySKBlockInfo_Just
  24. +0 −1 cardano-ledger/test/golden/cbor/delegation/ProxySKBlockInfo_Nothing
  25. +0 −64 cardano-ledger/test/golden/json/genesis/StaticConfig_GCSpec
  26. +0 −6 cardano-ledger/test/golden/json/genesis/StaticConfig_GCSrc
  27. +2 −0 cardano-ledger/test/test.hs
  28. +0 −5 crypto/cardano-crypto-wrapper.cabal
  29. +0 −1 crypto/src/Cardano/Crypto/Signing.hs
  30. +0 −7 crypto/src/Cardano/Crypto/Signing/Proxy.hs
  31. +0 −77 crypto/src/Cardano/Crypto/Signing/Proxy/Cert.hs
  32. +0 −146 crypto/src/Cardano/Crypto/Signing/Proxy/VerificationKey.hs
  33. +3 −3 crypto/src/Cardano/Crypto/Signing/Tag.hs
  34. +3 −3 crypto/src/Cardano/Crypto/Signing/VerificationKey.hs
  35. +0 −56 crypto/test/Test/Cardano/Crypto/CBOR.hs
  36. +1 −23 crypto/test/Test/Cardano/Crypto/Gen.hs
  37. +0 −90 crypto/test/Test/Cardano/Crypto/Signing/Proxy.hs
  38. +0 −5 crypto/test/golden/ProxyCert
  39. +0 −13 crypto/test/golden/ProxyVerificationKey
  40. +0 −2 crypto/test/test.hs
  41. +1 −0 nix/.stack.nix/cardano-ledger.nix
@@ -127,6 +127,7 @@ library
, bytestring
, canonical-json
, cardano-binary
, cardano-crypto
, cardano-crypto-wrapper
, cardano-prelude
, cardano-shell
@@ -183,6 +184,7 @@ test-suite cardano-ledger-test
Test.Cardano.Chain.Config

Test.Cardano.Chain.Delegation.CBOR
Test.Cardano.Chain.Delegation.Certificate
Test.Cardano.Chain.Delegation.Example
Test.Cardano.Chain.Delegation.Gen
Test.Cardano.Chain.Delegation.Model
@@ -106,8 +106,7 @@ import Cardano.Chain.Slotting
import Cardano.Chain.Update.ProtocolVersion (ProtocolVersion)
import Cardano.Chain.Update.SoftwareVersion (SoftwareVersion)
import Cardano.Crypto
( AProxyVerificationKey(..)
, Hash
( Hash
, ProtocolMagicId(..)
, Signature
, SignTag(..)
@@ -116,7 +115,6 @@ import Cardano.Crypto
, hashDecoded
, hashHexF
, hashRaw
, pskIssuerVK
, sign
, unsafeAbstractHash
)
@@ -221,7 +219,7 @@ mkHeaderExplicit pm prevHash difficulty epochSlots slotId sk dlgCert body pv sv
where
proof = mkProof body

genesisVK = pskIssuerVK dlgCert
genesisVK = Delegation.issuerVK dlgCert

sig = ABlockSignature dlgCert $ sign pm (SignBlock genesisVK) sk toSign

@@ -251,7 +249,7 @@ headerProof = unAnnotated . aHeaderProof

headerIssuer :: AHeader a -> VerificationKey
headerIssuer h = case headerSignature h of
ABlockSignature cert _ -> pskDelegateVK cert
ABlockSignature cert _ -> Delegation.delegateVK cert

headerToSign :: EpochSlots -> AHeader a -> ToSign
headerToSign epochSlots h = ToSign
@@ -1,45 +1,208 @@
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}

{-# OPTIONS_GHC -fno-warn-orphans #-}

module Cardano.Chain.Delegation.Certificate
( Certificate
, ACertificate
(
-- * Certificate
Certificate
, ACertificate(..)

-- * Certificate Constructors
, mkCertificate
, unsafeCertificate

-- * Certificate Accessor
, epoch

-- * Certificate Predicate
, isValid
)
where

import Cardano.Prelude

import qualified Cardano.Crypto.Wallet as CC
import Data.Coerce (coerce)
import Formatting (bprint, build)
import qualified Formatting.Buildable as B
import Text.JSON.Canonical
(FromJSON(..), Int54, JSValue(..), ToJSON(..), fromJSField, mkObject)

import Cardano.Binary
( Annotated(..)
, ByteSpan
, FromCBOR(..)
, ToCBOR(..)
, fromCBORAnnotated
, encodeListLen
, enforceSize
, serialize'
)
import Cardano.Chain.Slotting (EpochIndex)
import Cardano.Crypto
(AProxyVerificationKey(..), pskOmega, unsafeProxyVerificationKey)
( ProtocolMagicId
, SafeSigner
, SignTag(SignCertificate)
, Signature
, VerificationKey(unVerificationKey)
, safeSign
, safeToVerification
, verifySignatureDecoded
)


--------------------------------------------------------------------------------
-- Certificate
--------------------------------------------------------------------------------

-- | A delegation certificate is a `ProxyVerificationKey` tagged with an `EpochIndex`
type Certificate = ACertificate ()

type ACertificate a = AProxyVerificationKey EpochIndex a
-- | Delegation certificate allowing the @delegateVK@ to sign blocks on behalf
-- of @issuerVK@
--
-- Each delegator can publish at most one 'Certificate' per 'EpochIndex', and
-- that 'EpochIndex' must correspond to the current or next 'EpochIndex' at
-- the time of publishing
data ACertificate a = UnsafeACertificate
{ aEpoch :: Annotated EpochIndex a
-- ^ The epoch from which the delegation is valid
, issuerVK :: VerificationKey
-- ^ The issuer of the certificate, who delegates their right to sign blocks
, delegateVK :: VerificationKey
-- ^ The delegate, who gains the right to sign blocks
, signature :: Signature EpochIndex
-- ^ The signature that proves the certificate was issued by @issuerVK@
} deriving (Eq, Ord, Show, Generic, Functor)
deriving anyclass NFData


--------------------------------------------------------------------------------
-- Certificate Constructors
--------------------------------------------------------------------------------

-- | Create a valid 'Certificate'
mkCertificate
:: ProtocolMagicId
-> SafeSigner
-> VerificationKey
-> EpochIndex
-> Certificate
mkCertificate pm ss delegateVK e = UnsafeACertificate
{ aEpoch = Annotated e ()
, issuerVK = safeToVerification ss
, delegateVK = delegateVK
, signature = coerce sig
}
where
sig = safeSign pm SignCertificate ss
$ mconcat ["00", CC.unXPub (unVerificationKey delegateVK), serialize' e]

unsafeCertificate
:: EpochIndex
-> VerificationKey
-> VerificationKey
-> Signature EpochIndex
-> Certificate
unsafeCertificate e = UnsafeACertificate (Annotated e ())


--------------------------------------------------------------------------------
-- Certificate Accessor
--------------------------------------------------------------------------------

epoch :: ACertificate a -> EpochIndex
epoch = unAnnotated . aEpoch


--------------------------------------------------------------------------------
-- Certificate Predicate
--------------------------------------------------------------------------------

-- | A 'Certificate' is valid if the 'Signature' is valid
isValid
:: Annotated ProtocolMagicId ByteString
-> ACertificate ByteString
-> Bool
isValid pm UnsafeACertificate { aEpoch, issuerVK, delegateVK, signature } =
verifySignatureDecoded
pm
SignCertificate
issuerVK
( serialize'
. mappend ("00" <> CC.unXPub (unVerificationKey delegateVK))
<$> aEpoch
)
signature


--------------------------------------------------------------------------------
-- Certificate Binary Serialization
--------------------------------------------------------------------------------

instance ToCBOR Certificate where
toCBOR cert =
encodeListLen 4
<> toCBOR (epoch cert)
<> toCBOR (issuerVK cert)
<> toCBOR (delegateVK cert)
<> toCBOR (signature cert)

instance FromCBOR Certificate where
fromCBOR = void <$> fromCBOR @(ACertificate ByteSpan)

instance FromCBOR (ACertificate ByteSpan) where
fromCBOR = do
enforceSize "Delegation.Certificate" 4
UnsafeACertificate
<$> fromCBORAnnotated
<*> fromCBOR
<*> fromCBOR
<*> fromCBOR


--------------------------------------------------------------------------------
-- Certificate Formatting
--------------------------------------------------------------------------------

instance B.Buildable (ACertificate a) where
build (UnsafeACertificate e iVK dVK _) = bprint
( "Delegation.Certificate { w = " . build
. ", iVK = " . build
. ", dVK = " . build
. " }"
)
(unAnnotated e)
iVK
dVK


--------------------------------------------------------------------------------
-- Certificate Canonical JSON
--------------------------------------------------------------------------------

instance Monad m => ToJSON m Certificate where
toJSON psk = mkObject
toJSON cert = mkObject
-- omega is encoded as a number, because in genesis we always set it to 0
[ ("omega", pure (JSNum . fromIntegral $ pskOmega psk))
, ("issuerPk" , toJSON $ pskIssuerVK psk)
, ("delegatePk", toJSON $ pskDelegateVK psk)
, ("cert" , toJSON $ pskCert psk)
[ ("omega", pure (JSNum . fromIntegral $ epoch cert))
, ("issuerPk" , toJSON $ issuerVK cert)
, ("delegatePk", toJSON $ delegateVK cert)
, ("cert" , toJSON $ signature cert)
]

instance MonadError SchemaError m => FromJSON m Certificate where
fromJSON obj =
unsafeProxyVerificationKey
unsafeCertificate
<$> (fromIntegral @Int54 <$> fromJSField obj "omega")
<*> fromJSField obj "issuerPk"
<*> fromJSField obj "delegatePk"
@@ -31,8 +31,7 @@ import Cardano.Binary
import qualified Cardano.Chain.Delegation.Certificate as Delegation


-- | 'Payload' is put into 'MainBlock' and is a set of heavyweight proxy signing
-- keys. List of psk issuers should be unique also.
-- | The delegation 'Payload' contains a list of delegation 'Certificate's
data APayload a = UnsafeAPayload
{ getPayload :: [Delegation.ACertificate a]
, getAnnotation :: a
@@ -36,8 +36,7 @@ import Cardano.Chain.Slotting
, addSlotNumber
, subSlotNumber
)
import Cardano.Crypto
(AProxyVerificationKey(..), ProtocolMagicId, VerificationKey, pskOmega)
import Cardano.Crypto (ProtocolMagicId, VerificationKey)


--------------------------------------------------------------------------------
@@ -74,8 +73,8 @@ initialState
initialState env genesisDelegation = updateDelegation env' is certificates
where
Environment { allowedDelegators } = env
-- We modify the environment here to allow the delegation certificates to
-- be applied immediately. Since the environment is not propagated, this
-- We modify the environment here to allow the delegation certificates to
-- be applied immediately. Since the environment is not propagated, this
-- should be harmless.
env' = env { k = BlockCount 0 }

@@ -97,11 +96,10 @@ initialState env genesisDelegation = updateDelegation env' is certificates
fmap annotateCertificate . M.elems $ unGenesisDelegation genesisDelegation

annotateCertificate :: Certificate -> ACertificate ByteString
annotateCertificate c = UnsafeAProxyVerificationKey
{ aPskOmega = Annotated (pskOmega c) (serialize' $ pskOmega c)
, pskIssuerVK = pskIssuerVK c
, pskDelegateVK = pskDelegateVK c
, pskCert = pskCert c
annotateCertificate c = c
{ Delegation.aEpoch = Annotated
(Delegation.epoch c)
(serialize' $ Delegation.epoch c)
}


@@ -23,18 +23,14 @@ import qualified Data.Set as Set
import Cardano.Binary (Annotated)
import Cardano.Chain.Common (BlockCount, KeyHash, hashKey)
import Cardano.Chain.Delegation.Certificate (ACertificate)
import qualified Cardano.Chain.Delegation.Certificate as Certificate
import Cardano.Chain.ProtocolConstants (kSlotSecurityParam)
import Cardano.Chain.Slotting
( EpochIndex
, FlatSlotId(..)
, addSlotNumber
)
import Cardano.Crypto
( AProxyVerificationKey(..)
, ProtocolMagicId
, pskOmega
, validateProxyVerificationKey
)
import Cardano.Crypto (ProtocolMagicId)


--------------------------------------------------------------------------------
@@ -62,7 +58,7 @@ data ScheduledDelegation = ScheduledDelegation

data Error

= InvalidCertificate Text
= InvalidCertificate
-- ^ The delegation certificate has an invalid signature

| MultipleDelegationsForEpoch EpochIndex KeyHash
@@ -107,7 +103,7 @@ scheduleCertificate env st cert = do
`orThrowError` MultipleDelegationsForSlot currentSlot delegator

-- Check that the delegation certificate is valid
validateProxyVerificationKey protocolMagic cert `wrapError` InvalidCertificate
Certificate.isValid protocolMagic cert `orThrowError` InvalidCertificate

-- Schedule the new delegation and register the epoch/delegator pair
pure $ State
@@ -122,10 +118,10 @@ scheduleCertificate env st cert = do

State { scheduledDelegations, keyEpochDelegations } = st

delegator = hashKey $ pskIssuerVK cert
delegate = hashKey $ pskDelegateVK cert
delegator = hashKey $ Certificate.issuerVK cert
delegate = hashKey $ Certificate.delegateVK cert

delegationEpoch = pskOmega cert
delegationEpoch = Certificate.epoch cert

activationSlot = addSlotNumber (kSlotSecurityParam k) currentSlot

0 comments on commit 808f8df

Please sign in to comment.
You can’t perform that action at this time.