← Back to branch summary

~zinigor/cardano-node/trunk

« back to all changes in this revision

Viewing changes to cardano-node/src/Cardano/Node/Protocol/Byron.hs

  • Committer: Igor Zinovyev
  • Date: 2021-08-13 19:12:27 UTC
  • Revision ID: zinigor@gmail.com-20210813191227-stlnsj3mc5ypwn0c
Tags: upstream-1.27.0
Import upstream version 1.27.0

Show diffs side-by-side

added added

removed removed

Lines of Context:
cardano-node/src/Cardano/Node/Protocol/Byron.hs
 
1
{-# LANGUAGE NamedFieldPuns #-}
 
2
 
 
3
module Cardano.Node.Protocol.Byron
 
4
  ( mkSomeConsensusProtocolByron
 
5
    -- * Errors
 
6
  , ByronProtocolInstantiationError(..)
 
7
  , renderByronProtocolInstantiationError
 
8
 
 
9
    -- * Reusable parts
 
10
  , readGenesis
 
11
  , readLeaderCredentials
 
12
  ) where
 
13
 
 
14
 
 
15
import           Cardano.Prelude
 
16
import           Control.Monad.Trans.Except.Extra (bimapExceptT, firstExceptT, hoistEither,
 
17
                     hoistMaybe, left)
 
18
import qualified Data.ByteString.Lazy as LB
 
19
import qualified Data.Text as Text
 
20
 
 
21
import           Cardano.Api.Byron
 
22
import qualified Cardano.Api.Protocol.Types as Protocol
 
23
 
 
24
import qualified Cardano.Crypto.Hash as Crypto
 
25
 
 
26
import qualified Cardano.Crypto.Hashing as Byron.Crypto
 
27
 
 
28
import qualified Cardano.Chain.Genesis as Genesis
 
29
import qualified Cardano.Chain.Update as Update
 
30
import qualified Cardano.Chain.UTxO as UTxO
 
31
import           Cardano.Crypto.ProtocolMagic (RequiresNetworkMagic)
 
32
 
 
33
import           Ouroboros.Consensus.Cardano
 
34
import qualified Ouroboros.Consensus.Cardano as Consensus
 
35
 
 
36
import           Cardano.Node.Types
 
37
 
 
38
import           Cardano.Tracing.OrphanInstances.Byron ()
 
39
import           Cardano.Tracing.OrphanInstances.HardFork ()
 
40
 
 
41
import           Cardano.Node.Protocol.Types
 
42
 
 
43
 
 
44
------------------------------------------------------------------------------
 
45
-- Byron protocol
 
46
--
 
47
 
 
48
-- | Make 'SomeConsensusProtocol' using the Byron instance.
 
49
--
 
50
-- This lets us handle multiple protocols in a generic way.
 
51
--
 
52
-- This also serves a purpose as a sanity check that we have all the necessary
 
53
-- type class instances available.
 
54
--
 
55
mkSomeConsensusProtocolByron
 
56
  :: NodeByronProtocolConfiguration
 
57
  -> Maybe ProtocolFilepaths
 
58
  -> ExceptT ByronProtocolInstantiationError IO SomeConsensusProtocol
 
59
mkSomeConsensusProtocolByron NodeByronProtocolConfiguration {
 
60
                           npcByronGenesisFile,
 
61
                           npcByronGenesisFileHash,
 
62
                           npcByronReqNetworkMagic,
 
63
                           npcByronPbftSignatureThresh,
 
64
                           npcByronApplicationName,
 
65
                           npcByronApplicationVersion,
 
66
                           npcByronSupportedProtocolVersionMajor,
 
67
                           npcByronSupportedProtocolVersionMinor,
 
68
                           npcByronSupportedProtocolVersionAlt
 
69
                         }
 
70
                         files = do
 
71
    genesisConfig <- readGenesis npcByronGenesisFile
 
72
                                 npcByronGenesisFileHash
 
73
                                 npcByronReqNetworkMagic
 
74
 
 
75
    optionalLeaderCredentials <- readLeaderCredentials genesisConfig files
 
76
 
 
77
    return $ SomeConsensusProtocol Protocol.ByronBlockType $ Protocol.ProtocolInfoArgsByron $ Consensus.ProtocolParamsByron {
 
78
        byronGenesis = genesisConfig,
 
79
        byronPbftSignatureThreshold =
 
80
          PBftSignatureThreshold <$> npcByronPbftSignatureThresh,
 
81
        byronProtocolVersion =
 
82
          Update.ProtocolVersion
 
83
            npcByronSupportedProtocolVersionMajor
 
84
            npcByronSupportedProtocolVersionMinor
 
85
            npcByronSupportedProtocolVersionAlt,
 
86
        byronSoftwareVersion =
 
87
          Update.SoftwareVersion
 
88
            npcByronApplicationName
 
89
            npcByronApplicationVersion,
 
90
        byronLeaderCredentials =
 
91
          optionalLeaderCredentials
 
92
        }
 
93
 
 
94
readGenesis :: GenesisFile
 
95
            -> Maybe GenesisHash
 
96
            -> RequiresNetworkMagic
 
97
            -> ExceptT ByronProtocolInstantiationError IO
 
98
                       Genesis.Config
 
99
readGenesis (GenesisFile file) mbExpectedGenesisHash ncReqNetworkMagic = do
 
100
    (genesisData, genesisHash) <- firstExceptT (GenesisReadError file) $
 
101
                                  Genesis.readGenesisData file
 
102
    checkExpectedGenesisHash genesisHash
 
103
    return Genesis.Config {
 
104
      Genesis.configGenesisData       = genesisData,
 
105
      Genesis.configGenesisHash       = genesisHash,
 
106
      Genesis.configReqNetMagic       = ncReqNetworkMagic,
 
107
      Genesis.configUTxOConfiguration = UTxO.defaultUTxOConfiguration
 
108
      --TODO: add config support for the UTxOConfiguration if needed
 
109
    }
 
110
  where
 
111
    checkExpectedGenesisHash :: Genesis.GenesisHash
 
112
                             -> ExceptT ByronProtocolInstantiationError IO ()
 
113
    checkExpectedGenesisHash actual' =
 
114
      case mbExpectedGenesisHash of
 
115
        Just expected | actual /= expected ->
 
116
            throwError (GenesisHashMismatch actual expected)
 
117
          where
 
118
            actual = fromByronGenesisHash actual'
 
119
 
 
120
        _ -> return ()
 
121
 
 
122
    fromByronGenesisHash :: Genesis.GenesisHash -> GenesisHash
 
123
    fromByronGenesisHash (Genesis.GenesisHash h) =
 
124
        GenesisHash
 
125
      . fromMaybe impossible
 
126
      . Crypto.hashFromBytes
 
127
      . Byron.Crypto.hashToBytes
 
128
      $ h
 
129
      where
 
130
        impossible =
 
131
          panic "fromByronGenesisHash: old and new crypto libs disagree on hash size"
 
132
 
 
133
 
 
134
 
 
135
readLeaderCredentials :: Genesis.Config
 
136
                      -> Maybe ProtocolFilepaths
 
137
                      -> ExceptT ByronProtocolInstantiationError IO
 
138
                                 (Maybe ByronLeaderCredentials)
 
139
readLeaderCredentials _ Nothing = return Nothing
 
140
readLeaderCredentials genesisConfig
 
141
                      (Just ProtocolFilepaths {
 
142
                        byronCertFile,
 
143
                        byronKeyFile
 
144
                      }) =
 
145
  case (byronCertFile, byronKeyFile) of
 
146
    (Nothing, Nothing) -> pure Nothing
 
147
    (Just _, Nothing) -> left SigningKeyFilepathNotSpecified
 
148
    (Nothing, Just _) -> left DelegationCertificateFilepathNotSpecified
 
149
    (Just delegCertFile, Just signingKeyFile) -> do
 
150
 
 
151
         signingKeyFileBytes <- liftIO $ LB.readFile signingKeyFile
 
152
         delegCertFileBytes <- liftIO $ LB.readFile delegCertFile
 
153
         ByronSigningKey signingKey <- hoistMaybe (SigningKeyDeserialiseFailure signingKeyFile)
 
154
                         $ deserialiseFromRawBytes (AsSigningKey AsByronKey) $ LB.toStrict signingKeyFileBytes
 
155
         delegCert  <- firstExceptT (CanonicalDecodeFailure delegCertFile)
 
156
                         . hoistEither
 
157
                         $ canonicalDecodePretty delegCertFileBytes
 
158
 
 
159
         bimapExceptT CredentialsError Just
 
160
           . hoistEither
 
161
           $ mkByronLeaderCredentials genesisConfig signingKey delegCert "Byron"
 
162
 
 
163
 
 
164
 
 
165
------------------------------------------------------------------------------
 
166
-- Byron Errors
 
167
--
 
168
 
 
169
data ByronProtocolInstantiationError =
 
170
    CanonicalDecodeFailure !FilePath !Text
 
171
  | GenesisHashMismatch !GenesisHash !GenesisHash -- actual, expected
 
172
  | DelegationCertificateFilepathNotSpecified
 
173
  | GenesisConfigurationError !FilePath !Genesis.ConfigurationError
 
174
  | GenesisReadError !FilePath !Genesis.GenesisDataError
 
175
  | CredentialsError !ByronLeaderCredentialsError
 
176
  | SigningKeyDeserialiseFailure !FilePath
 
177
  | SigningKeyFilepathNotSpecified
 
178
  deriving Show
 
179
 
 
180
 
 
181
renderByronProtocolInstantiationError :: ByronProtocolInstantiationError -> Text
 
182
renderByronProtocolInstantiationError pie =
 
183
  case pie of
 
184
    CanonicalDecodeFailure fp failure -> "Canonical decode failure in " <> toS fp
 
185
                                         <> " Canonical failure: " <> failure
 
186
    GenesisHashMismatch actual expected ->
 
187
        "Wrong Byron genesis file: the actual hash is " <> show actual
 
188
     <> ", but the expected Byron genesis hash given in the node configuration "
 
189
     <> "file is " <> show expected
 
190
    DelegationCertificateFilepathNotSpecified -> "Delegation certificate filepath not specified"
 
191
    --TODO: Implement configuration error render function in cardano-ledger
 
192
    GenesisConfigurationError fp genesisConfigError -> "Genesis configuration error in: " <> toS fp
 
193
                                                       <> " Error: " <> Text.pack (show genesisConfigError)
 
194
    GenesisReadError fp err ->  "There was an error parsing the genesis file: " <> toS fp
 
195
                                <> " Error: " <> Text.pack (show err)
 
196
    -- TODO: Implement ByronLeaderCredentialsError render function in ouroboros-network
 
197
    CredentialsError byronLeaderCredentialsError -> "Byron leader credentials error: " <> Text.pack (show byronLeaderCredentialsError)
 
198
    SigningKeyDeserialiseFailure fp -> "Signing key deserialisation error in: " <> toS fp
 
199
    SigningKeyFilepathNotSpecified -> "Signing key filepath not specified"