/
Delegation.hs
125 lines (109 loc) · 4.62 KB
/
Delegation.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.CLI.Byron.Delegation
( ByronDelegationError(..)
, checkByronGenesisDelegation
, issueByronGenesisDelegation
, renderByronDelegationError
, serialiseDelegationCert
, serialiseDelegateKey
)
where
import Cardano.Prelude hiding (option, show, trace)
import Codec.CBOR.Write (toLazyByteString)
import Control.Monad.Trans.Except.Extra (left)
import qualified Data.ByteString.Lazy as LB
import Formatting (Format, sformat)
import Cardano.Binary (Annotated (..), serialize')
import qualified Cardano.Chain.Delegation as Dlg
import Cardano.Chain.Slotting (EpochNumber)
import qualified Cardano.CLI.Byron.Legacy as Legacy
import Cardano.Crypto (ProtocolMagicId, SigningKey)
import qualified Cardano.Crypto as Crypto
import Cardano.CLI.Byron.Key (ByronKeyFailure, CardanoEra (..), renderByronKeyFailure,
serialiseSigningKey)
import Cardano.CLI.Helpers (textShow)
import Cardano.CLI.Types (CertificateFile (..))
data ByronDelegationError
= CertificateValidationErrors !FilePath ![Text]
| DlgCertificateDeserialisationFailed !FilePath !Text
| ByronDelegationKeyError !ByronKeyFailure
deriving Show
renderByronDelegationError :: ByronDelegationError -> Text
renderByronDelegationError err =
case err of
CertificateValidationErrors certFp errs ->
"Certificate validation error(s) at: " <> textShow certFp <> " Errors: " <> textShow errs
DlgCertificateDeserialisationFailed certFp deSererr ->
"Certificate deserialisation error at: " <> textShow certFp <> " Error: " <> textShow deSererr
ByronDelegationKeyError kerr -> renderByronKeyFailure kerr
-- TODO: we need to support password-protected secrets.
-- | Issue a certificate for genesis delegation to a delegate key, signed by the
-- issuer key, for a given protocol magic and coming into effect at given epoch.
issueByronGenesisDelegation
:: ProtocolMagicId
-> EpochNumber
-> Crypto.SigningKey
-> Crypto.VerificationKey
-> Dlg.Certificate
issueByronGenesisDelegation magic epoch issuerSK delegateVK =
Dlg.signCertificate magic delegateVK epoch $
Crypto.noPassSafeSigner issuerSK
-- | Verify that a certificate signifies genesis delegation by assumed genesis key
-- to a delegate key, for a given protocol magic.
-- If certificate fails validation, throw an error.
checkByronGenesisDelegation
:: CertificateFile
-> ProtocolMagicId
-> Crypto.VerificationKey
-> Crypto.VerificationKey
-> ExceptT ByronDelegationError IO ()
checkByronGenesisDelegation (CertificateFile certF) magic issuer delegate = do
ecert <- liftIO $ canonicalDecodePretty <$> LB.readFile certF
case ecert of
Left e -> left $ DlgCertificateDeserialisationFailed certF e
Right (cert :: Dlg.Certificate) -> do
let issues = checkDlgCert cert magic issuer delegate
unless (null issues) $
left $ CertificateValidationErrors certF issues
checkDlgCert
:: Dlg.ACertificate a
-> ProtocolMagicId
-> Crypto.VerificationKey
-> Crypto.VerificationKey -> [Text]
checkDlgCert cert magic issuerVK' delegateVK' =
mconcat $
[ [ sformat ("Certificate does not have a valid signature.")
| not (Dlg.isValid magic' cert')
]
, [ sformat ("Certificate issuer ".vkF." doesn't match expected: ".vkF)
( Dlg.issuerVK cert) issuerVK'
| Dlg.issuerVK cert /= issuerVK'
]
, [ sformat ("Certificate delegate ".vkF." doesn't match expected: ".vkF)
( Dlg.delegateVK cert) delegateVK'
| Dlg.delegateVK cert /= delegateVK'
]
]
where
magic' :: Annotated ProtocolMagicId ByteString
magic' = Annotated magic (serialize' magic)
epoch :: EpochNumber
epoch = unAnnotated $ Dlg.aEpoch cert
cert' :: Dlg.ACertificate ByteString
cert' = cert { Dlg.aEpoch = Annotated epoch (serialize' epoch)
, Dlg.annotation = serialize' (void cert')
}
vkF :: forall r. Format r (Crypto.VerificationKey -> r)
vkF = Crypto.fullVerificationKeyF
serialiseDelegationCert :: Dlg.Certificate -> LB.ByteString
serialiseDelegationCert = canonicalEncodePretty
serialiseDelegateKey :: CardanoEra -> SigningKey -> Either ByronDelegationError LB.ByteString
serialiseDelegateKey ByronEraLegacy sk = pure
. toLazyByteString
. Legacy.encodeLegacyDelegateKey
$ Legacy.LegacyDelegateKey sk
serialiseDelegateKey ByronEra sk =
first ByronDelegationKeyError $
serialiseSigningKey ByronEra sk