Merge #2209

2209: Incorporate byron votes and proposals into cardano-api r=Jimbo4350 a=Jimbo4350



Co-authored-by: Jordan Millar <[email protected]>

cardano-api/cardano-api.cabal

@@ -58,6 +58,7 @@ library
                         Cardano.Api.SerialiseJSON
                         Cardano.Api.SerialiseRaw
                         Cardano.Api.SerialiseTextEnvelope
+                        Cardano.Api.SpecialByron
                         Cardano.Api.StakePoolMetadata
                         Cardano.Api.Tx
                         Cardano.Api.TxBody

cardano-api/src/Cardano/Api/Byron.hs

@@ -5,6 +5,7 @@
 
 module Cardano.Api.Byron
   ( module Cardano.Api,
+    AsType(..),
 
     -- * Cryptographic key interface
     -- $keys
@@ -67,11 +68,24 @@ module Cardano.Api.Byron
     -- * Address
     NetworkMagic(..),
 
+    -- * Update Proposal
+    ByronUpdateProposal(..),
+    ByronProtocolParametersUpdate (..),
+    makeByronUpdateProposal,
+    toByronLedgerUpdateProposal,
+    makeProtocolParametersUpdate,
+
+    -- * Vote
+    ByronVote(..),
+    makeByronVote,
+    toByronLedgertoByronVote,
+
     -- ** Conversions
     toByronNetworkMagic,
     toByronProtocolMagicId,
     toByronRequiresNetworkMagic,
   ) where
 
 import           Cardano.Api
+import           Cardano.Api.SpecialByron
 import           Cardano.Api.Typed

cardano-api/src/Cardano/Api/KeysByron.hs

@@ -29,12 +29,12 @@ import qualified Cardano.Crypto.DSIGN.Class as Crypto
 import qualified Cardano.Crypto.Seed as Crypto
 import qualified Cardano.Crypto.Wallet as Crypto.HD
 
+import qualified Cardano.Chain.Common as Byron
 import qualified Cardano.Crypto.Hashing as Byron
 import qualified Cardano.Crypto.Signing as Byron
-import qualified Cardano.Chain.Common as Byron
 
-import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Hash
+import           Cardano.Api.HasTypeProxy
 import           Cardano.Api.Key
 import           Cardano.Api.KeysShelley
 import           Cardano.Api.SerialiseBech32

cardano-api/src/Cardano/Api/SpecialByron.hs

@@ -0,0 +1,200 @@
+{-# LANGUAGE TypeFamilies #-}
+
+-- | Special Byron values that we can submit to a node to propose an update proposal
+-- or to vote on an update proposal. These are not transactions.
+--
+module Cardano.Api.SpecialByron
+  ( ByronUpdateProposal(..),
+    ByronProtocolParametersUpdate(..),
+    AsType(AsByronUpdateProposal, AsByronVote),
+    makeProtocolParametersUpdate,
+    toByronLedgerUpdateProposal,
+    ByronVote(..),
+    makeByronUpdateProposal,
+    makeByronVote,
+    toByronLedgertoByronVote,
+  ) where
+
+import           Prelude
+
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString.Lazy as LB
+import qualified Data.Map.Strict as M
+import           Data.Word
+import           Numeric.Natural
+
+import           Cardano.Api.HasTypeProxy
+import           Cardano.Api.Key
+import           Cardano.Api.KeysByron
+import           Cardano.Api.NetworkId (NetworkId, toByronProtocolMagicId)
+import           Cardano.Api.SerialiseRaw
+
+import qualified Cardano.Binary as Binary
+import           Cardano.Chain.Common (LovelacePortion, TxFeePolicy)
+import           Cardano.Chain.Slotting
+import           Cardano.Chain.Update (AProposal (aBody, annotation), InstallerHash,
+                     ProposalBody (ProposalBody), ProtocolParametersUpdate (..), ProtocolVersion,
+                     SoftforkRule, SoftwareVersion, SystemTag, UpId, mkVote, recoverUpId,
+                     recoverVoteId, signProposal)
+import qualified Cardano.Chain.Update.Vote as ByronVote
+import           Cardano.Crypto (SafeSigner, noPassSafeSigner)
+import           Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
+import qualified Ouroboros.Consensus.Byron.Ledger.Mempool as Mempool
+
+{- HLINT ignore "Use void" -}
+
+-- | Byron era update proposal
+
+newtype ByronUpdateProposal =
+    ByronUpdateProposal { unByronUpdateProposal :: AProposal ByteString}
+  deriving (Eq, Show)
+
+instance HasTypeProxy ByronUpdateProposal where
+  data AsType ByronUpdateProposal = AsByronUpdateProposal
+  proxyToAsType _ = AsByronUpdateProposal
+
+instance SerialiseAsRawBytes ByronUpdateProposal where
+  serialiseToRawBytes (ByronUpdateProposal proposal) = annotation proposal
+  deserialiseFromRawBytes AsByronUpdateProposal bs =
+    let lBs = LB.fromStrict bs
+    in case Binary.decodeFull lBs of
+        Left _deserFail -> Nothing
+        Right proposal -> Just (ByronUpdateProposal proposal')
+          where
+            proposal' :: AProposal ByteString
+            proposal' = Binary.annotationBytes lBs proposal
+
+makeByronUpdateProposal
+  :: NetworkId
+  -> ProtocolVersion
+  -> SoftwareVersion
+  -> SystemTag
+  -> InstallerHash
+  -> SigningKey ByronKey
+  -> ByronProtocolParametersUpdate
+  -> ByronUpdateProposal
+makeByronUpdateProposal nId pVer sVer sysTag insHash
+                          (ByronSigningKey sKey) paramsToUpdate =
+  let nonAnnotatedProposal :: AProposal ()
+      nonAnnotatedProposal = signProposal (toByronProtocolMagicId nId) proposalBody noPassSigningKey
+      annotatedPropBody :: Binary.Annotated ProposalBody ByteString
+      annotatedPropBody = Binary.reAnnotate $ aBody nonAnnotatedProposal
+  in ByronUpdateProposal
+       $ nonAnnotatedProposal { aBody = annotatedPropBody
+                              , annotation = Binary.serialize' nonAnnotatedProposal
+                              }
+ where
+   proposalBody :: ProposalBody
+   proposalBody = ProposalBody pVer protocolParamsUpdate sVer metaData
+
+   metaData :: M.Map SystemTag InstallerHash
+   metaData = M.singleton sysTag insHash
+
+   noPassSigningKey :: SafeSigner
+   noPassSigningKey = noPassSafeSigner sKey
+
+   protocolParamsUpdate :: ProtocolParametersUpdate
+   protocolParamsUpdate = makeProtocolParametersUpdate paramsToUpdate
+
+data ByronProtocolParametersUpdate =
+  ByronProtocolParametersUpdate
+    { bPpuScriptVersion     :: !(Maybe Word16)
+      -- ^ Redundant. This was meant to be the version of the
+      -- Plutus smart contract language, however, there are no
+      -- smart contracts nor scripts in the Byron era.
+    , bPpuSlotDuration      :: !(Maybe Natural)
+      -- ^ Slot duration in milliseconds.
+    , bPpuMaxBlockSize      :: !(Maybe Natural)
+      -- ^ Maximum block size in bytes.
+    , bPpuMaxHeaderSize     :: !(Maybe Natural)
+      -- ^ Maximum block header size in bytes.
+    , bPpuMaxTxSize         :: !(Maybe Natural)
+      -- ^ Maxiumum transaction size in bytes.
+    , bPpuMaxProposalSize   :: !(Maybe Natural)
+      -- ^ Maximum update proposal size in bytes.
+    , bPpuMpcThd            :: !(Maybe LovelacePortion)
+    , bPpuHeavyDelThd       :: !(Maybe LovelacePortion)
+      -- ^ Heavyweight delegation threshold. The delegate (i.e stakeholder)
+      -- must possess no less than this threshold of stake in order to participate
+      -- in heavyweight delegation.
+    , bPpuUpdateVoteThd     :: !(Maybe LovelacePortion)
+    , bPpuUpdateProposalThd :: !(Maybe LovelacePortion)
+    , bPpuUpdateProposalTTL :: !(Maybe SlotNumber)
+    , bPpuSoftforkRule      :: !(Maybe SoftforkRule)
+      -- ^ Values defining the softfork resolution rule. When the stake belonging
+      -- to block issuers, issuing a given block version, is greater than the
+      -- current softfork resolution threshold, this block version is adopted.
+    , bPpuTxFeePolicy       :: !(Maybe TxFeePolicy)
+      -- ^ Transaction fee policy represents a formula to compute the minimal allowed
+      -- Fee for a transaction. Transactions with lesser fees won't be accepted.
+    , bPpuUnlockStakeEpoch  :: !(Maybe EpochNumber)
+      -- ^ This has been re-purposed for unlocking the OuroborosBFT logic in the software.
+      -- Relevant: [CDEC-610](https://iohk.myjetbrains.com/youtrack/issue/CDEC-610)
+    } deriving Show
+
+makeProtocolParametersUpdate
+  :: ByronProtocolParametersUpdate
+  -> ProtocolParametersUpdate
+makeProtocolParametersUpdate apiPpu =
+  ProtocolParametersUpdate
+    { ppuScriptVersion = bPpuScriptVersion apiPpu
+    , ppuSlotDuration = bPpuSlotDuration apiPpu
+    , ppuMaxBlockSize = bPpuMaxBlockSize apiPpu
+    , ppuMaxHeaderSize = bPpuMaxHeaderSize apiPpu
+    , ppuMaxTxSize = bPpuMaxTxSize apiPpu
+    , ppuMaxProposalSize = bPpuMaxProposalSize apiPpu
+    , ppuMpcThd = bPpuMpcThd apiPpu
+    , ppuHeavyDelThd = bPpuHeavyDelThd apiPpu
+    , ppuUpdateVoteThd = bPpuUpdateVoteThd apiPpu
+    , ppuUpdateProposalThd = bPpuUpdateProposalThd apiPpu
+    , ppuUpdateProposalTTL = bPpuUpdateProposalTTL apiPpu
+    , ppuSoftforkRule = bPpuSoftforkRule apiPpu
+    , ppuTxFeePolicy = bPpuTxFeePolicy apiPpu
+    , ppuUnlockStakeEpoch = bPpuUnlockStakeEpoch apiPpu
+    }
+
+toByronLedgerUpdateProposal :: ByronUpdateProposal -> Mempool.GenTx ByronBlock
+toByronLedgerUpdateProposal (ByronUpdateProposal proposal) =
+  Mempool.ByronUpdateProposal (recoverUpId proposal) proposal
+
+-- | Byron era votes
+
+newtype ByronVote = ByronVote { unByronVote :: ByronVote.AVote ByteString }
+  deriving (Eq, Show)
+
+instance HasTypeProxy ByronVote where
+  data AsType ByronVote = AsByronVote
+  proxyToAsType _ = AsByronVote
+
+instance SerialiseAsRawBytes ByronVote where
+  serialiseToRawBytes (ByronVote vote) = Binary.serialize' $ fmap (const ()) vote
+  deserialiseFromRawBytes AsByronVote bs =
+    let lBs = LB.fromStrict bs
+    in case Binary.decodeFull lBs of
+         Left _deserFail -> Nothing
+         Right vote -> Just . ByronVote $ annotateVote vote lBs
+   where
+    annotateVote :: ByronVote.AVote Binary.ByteSpan -> LB.ByteString -> ByronVote.AVote ByteString
+    annotateVote vote bs' = Binary.annotationBytes bs' vote
+
+
+makeByronVote
+  :: NetworkId
+  -> SigningKey ByronKey
+  -> ByronUpdateProposal
+  -> Bool
+  -> ByronVote
+makeByronVote nId (ByronSigningKey sKey) (ByronUpdateProposal proposal) yesOrNo =
+  let nonAnnotatedVote :: ByronVote.AVote ()
+      nonAnnotatedVote = mkVote (toByronProtocolMagicId nId) sKey (recoverUpId proposal) yesOrNo
+      annotatedProposalId :: Binary.Annotated UpId ByteString
+      annotatedProposalId = Binary.reAnnotate $ ByronVote.aProposalId nonAnnotatedVote
+  in ByronVote
+       $ nonAnnotatedVote { ByronVote.aProposalId = annotatedProposalId
+                          , ByronVote.annotation = Binary.annotation annotatedProposalId
+                          }
+
+toByronLedgertoByronVote :: ByronVote -> Mempool.GenTx ByronBlock
+toByronLedgertoByronVote (ByronVote vote) = Mempool.ByronUpdateVote (recoverVoteId vote) vote
+
+

cardano-cli/cardano-cli.cabal

@@ -231,6 +231,7 @@ test-suite cardano-cli-golden
                       , base16-bytestring
                       , cardano-api
                       , cardano-cli
+                      , cardano-ledger
                       , cardano-prelude
                       , containers
                       , deepseq
@@ -248,10 +249,12 @@ test-suite cardano-cli-golden
                       , unordered-containers
 
   other-modules:        Test.Golden.Shelley
-                        Test.Golden.Byron.TextEnvelope.PaymentKeys
-                        Test.Golden.Byron.TextEnvelope.Tx
-                        Test.Golden.Byron.TextEnvelope.TxBody
-                        Test.Golden.Byron.TextEnvelope.Witness
+                        Test.Golden.Byron.PaymentKeys
+                        Test.Golden.Byron.Tx
+                        Test.Golden.Byron.TxBody
+                        Test.Golden.Byron.UpdateProposal
+                        Test.Golden.Byron.Vote
+                        Test.Golden.Byron.Witness
                         Test.Golden.Shelley.Address.Build
                         Test.Golden.Shelley.Address.Info
                         Test.Golden.Shelley.Address.KeyGen

cardano-cli/src/Cardano/CLI/Byron/Commands.hs

@@ -15,8 +15,8 @@ import           Cardano.Chain.Update (InstallerHash (..), ProtocolVersion (..),
                      SoftwareVersion (..), SystemTag (..))
 
 import           Cardano.Api (NetworkId)
+import           Cardano.Api.Byron (ByronProtocolParametersUpdate (..))
 
-import           Cardano.CLI.Byron.UpdateProposal
 
 import           Cardano.CLI.Byron.Genesis
 import           Cardano.CLI.Byron.Key
@@ -131,7 +131,7 @@ data NodeCmd = CreateVote
                SystemTag
                InstallerHash
                FilePath
-               [ParametersToUpdate]
+               ByronProtocolParametersUpdate
              | SubmitUpdateProposal
                NetworkId
                FilePath