{-# LANGUAGE TypeFamilies #-}
module Cardano.Api.Internal.SpecialByron
( ByronUpdateProposal (..)
, ByronProtocolParametersUpdate (..)
, AsType (AsByronUpdateProposal, AsByronVote)
, makeProtocolParametersUpdate
, toByronLedgerUpdateProposal
, ByronVote (..)
, makeByronUpdateProposal
, makeByronVote
, toByronLedgertoByronVote
, applicationName
, applicationVersion
, softwareVersion
)
where
import Cardano.Api.Internal.HasTypeProxy
import Cardano.Api.Internal.Keys.Byron
import Cardano.Api.Internal.NetworkId (NetworkId, toByronProtocolMagicId)
import Cardano.Api.Internal.SerialiseRaw
import Cardano.Binary qualified 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 Cardano.Chain.Update qualified as Update
import Cardano.Chain.Update.Vote qualified as ByronVote
import Cardano.Crypto (SafeSigner, noPassSafeSigner)
import Cardano.Ledger.Binary qualified as Binary
( Annotated (..)
, ByteSpan (..)
, annotation
, annotationBytes
, byronProtVer
, reAnnotate
)
import Ouroboros.Consensus.Byron.Ledger.Block (ByronBlock)
import Ouroboros.Consensus.Byron.Ledger.Mempool qualified as Mempool
import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as LB
import Data.Map.Strict qualified as M
import Data.Word
import Numeric.Natural
newtype ByronUpdateProposal
= ByronUpdateProposal {ByronUpdateProposal -> AProposal ByteString
unByronUpdateProposal :: AProposal ByteString}
deriving (ByronUpdateProposal -> ByronUpdateProposal -> Bool
(ByronUpdateProposal -> ByronUpdateProposal -> Bool)
-> (ByronUpdateProposal -> ByronUpdateProposal -> Bool)
-> Eq ByronUpdateProposal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByronUpdateProposal -> ByronUpdateProposal -> Bool
== :: ByronUpdateProposal -> ByronUpdateProposal -> Bool
$c/= :: ByronUpdateProposal -> ByronUpdateProposal -> Bool
/= :: ByronUpdateProposal -> ByronUpdateProposal -> Bool
Eq, Int -> ByronUpdateProposal -> ShowS
[ByronUpdateProposal] -> ShowS
ByronUpdateProposal -> String
(Int -> ByronUpdateProposal -> ShowS)
-> (ByronUpdateProposal -> String)
-> ([ByronUpdateProposal] -> ShowS)
-> Show ByronUpdateProposal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronUpdateProposal -> ShowS
showsPrec :: Int -> ByronUpdateProposal -> ShowS
$cshow :: ByronUpdateProposal -> String
show :: ByronUpdateProposal -> String
$cshowList :: [ByronUpdateProposal] -> ShowS
showList :: [ByronUpdateProposal] -> ShowS
Show)
instance HasTypeProxy ByronUpdateProposal where
data AsType ByronUpdateProposal = AsByronUpdateProposal
proxyToAsType :: Proxy ByronUpdateProposal -> AsType ByronUpdateProposal
proxyToAsType Proxy ByronUpdateProposal
_ = AsType ByronUpdateProposal
AsByronUpdateProposal
instance SerialiseAsRawBytes ByronUpdateProposal where
serialiseToRawBytes :: ByronUpdateProposal -> ByteString
serialiseToRawBytes (ByronUpdateProposal AProposal ByteString
proposal) = AProposal ByteString -> ByteString
forall a. AProposal a -> a
annotation AProposal ByteString
proposal
deserialiseFromRawBytes :: AsType ByronUpdateProposal
-> ByteString
-> Either SerialiseAsRawBytesError ByronUpdateProposal
deserialiseFromRawBytes AsType ByronUpdateProposal
R:AsTypeByronUpdateProposal
AsByronUpdateProposal ByteString
bs =
let lBs :: LazyByteString
lBs = ByteString -> LazyByteString
LB.fromStrict ByteString
bs
in case LazyByteString -> Either DecoderError (AProposal ByteSpan)
forall a. FromCBOR a => LazyByteString -> Either DecoderError a
Binary.decodeFull LazyByteString
lBs of
Left DecoderError
e -> SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError ByronUpdateProposal
forall a b. a -> Either a b
Left (SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError ByronUpdateProposal)
-> SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError ByronUpdateProposal
forall a b. (a -> b) -> a -> b
$ String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String -> SerialiseAsRawBytesError)
-> String -> SerialiseAsRawBytesError
forall a b. (a -> b) -> a -> b
$ String
"Unable to deserialise ByronUpdateProposal: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DecoderError -> String
forall a. Show a => a -> String
show DecoderError
e
Right AProposal ByteSpan
proposal -> ByronUpdateProposal
-> Either SerialiseAsRawBytesError ByronUpdateProposal
forall a b. b -> Either a b
Right (AProposal ByteString -> ByronUpdateProposal
ByronUpdateProposal AProposal ByteString
proposal')
where
proposal' :: AProposal ByteString
proposal' :: AProposal ByteString
proposal' = LazyByteString -> AProposal ByteSpan -> AProposal ByteString
forall (f :: * -> *).
Functor f =>
LazyByteString -> f ByteSpan -> f ByteString
Binary.annotationBytes LazyByteString
lBs AProposal ByteSpan
proposal
makeByronUpdateProposal
:: NetworkId
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> SomeByronSigningKey
-> ByronProtocolParametersUpdate
-> ByronUpdateProposal
makeByronUpdateProposal :: NetworkId
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> SomeByronSigningKey
-> ByronProtocolParametersUpdate
-> ByronUpdateProposal
makeByronUpdateProposal
NetworkId
nId
ProtocolVersion
pVer
SoftwareVersion
sVer
SystemTag
sysTag
InstallerHash
insHash
SomeByronSigningKey
bWit
ByronProtocolParametersUpdate
paramsToUpdate =
let nonAnnotatedProposal :: AProposal ()
nonAnnotatedProposal :: AProposal ()
nonAnnotatedProposal = ProtocolMagicId -> ProposalBody -> SafeSigner -> AProposal ()
signProposal (NetworkId -> ProtocolMagicId
toByronProtocolMagicId NetworkId
nId) ProposalBody
proposalBody SafeSigner
noPassSigningKey
annotatedPropBody :: Binary.Annotated ProposalBody ByteString
annotatedPropBody :: Annotated ProposalBody ByteString
annotatedPropBody = Version
-> Annotated ProposalBody () -> Annotated ProposalBody ByteString
forall a b.
EncCBOR a =>
Version -> Annotated a b -> Annotated a ByteString
Binary.reAnnotate Version
Binary.byronProtVer (Annotated ProposalBody () -> Annotated ProposalBody ByteString)
-> Annotated ProposalBody () -> Annotated ProposalBody ByteString
forall a b. (a -> b) -> a -> b
$ AProposal () -> Annotated ProposalBody ()
forall a. AProposal a -> Annotated ProposalBody a
aBody AProposal ()
nonAnnotatedProposal
in AProposal ByteString -> ByronUpdateProposal
ByronUpdateProposal (AProposal ByteString -> ByronUpdateProposal)
-> AProposal ByteString -> ByronUpdateProposal
forall a b. (a -> b) -> a -> b
$
AProposal ()
nonAnnotatedProposal
{ aBody = annotatedPropBody
, annotation = Binary.serialize' nonAnnotatedProposal
}
where
proposalBody :: ProposalBody
proposalBody :: ProposalBody
proposalBody = ProtocolVersion
-> ProtocolParametersUpdate
-> SoftwareVersion
-> Map SystemTag InstallerHash
-> ProposalBody
ProposalBody ProtocolVersion
pVer ProtocolParametersUpdate
protocolParamsUpdate SoftwareVersion
sVer Map SystemTag InstallerHash
metaData
metaData :: M.Map SystemTag InstallerHash
metaData :: Map SystemTag InstallerHash
metaData = SystemTag -> InstallerHash -> Map SystemTag InstallerHash
forall k a. k -> a -> Map k a
M.singleton SystemTag
sysTag InstallerHash
insHash
noPassSigningKey :: SafeSigner
noPassSigningKey :: SafeSigner
noPassSigningKey = SigningKey -> SafeSigner
noPassSafeSigner (SigningKey -> SafeSigner) -> SigningKey -> SafeSigner
forall a b. (a -> b) -> a -> b
$ SomeByronSigningKey -> SigningKey
toByronSigningKey SomeByronSigningKey
bWit
protocolParamsUpdate :: ProtocolParametersUpdate
protocolParamsUpdate :: ProtocolParametersUpdate
protocolParamsUpdate = ByronProtocolParametersUpdate -> ProtocolParametersUpdate
makeProtocolParametersUpdate ByronProtocolParametersUpdate
paramsToUpdate
data ByronProtocolParametersUpdate
= ByronProtocolParametersUpdate
{ ByronProtocolParametersUpdate -> Maybe Word16
bPpuScriptVersion :: !(Maybe Word16)
, ByronProtocolParametersUpdate -> Maybe Natural
bPpuSlotDuration :: !(Maybe Natural)
, ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxBlockSize :: !(Maybe Natural)
, :: !(Maybe Natural)
, ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxTxSize :: !(Maybe Natural)
, ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxProposalSize :: !(Maybe Natural)
, ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuMpcThd :: !(Maybe LovelacePortion)
, ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuHeavyDelThd :: !(Maybe LovelacePortion)
, ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuUpdateVoteThd :: !(Maybe LovelacePortion)
, ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuUpdateProposalThd :: !(Maybe LovelacePortion)
, ByronProtocolParametersUpdate -> Maybe SlotNumber
bPpuUpdateProposalTTL :: !(Maybe SlotNumber)
, ByronProtocolParametersUpdate -> Maybe SoftforkRule
bPpuSoftforkRule :: !(Maybe SoftforkRule)
, ByronProtocolParametersUpdate -> Maybe TxFeePolicy
bPpuTxFeePolicy :: !(Maybe TxFeePolicy)
, ByronProtocolParametersUpdate -> Maybe EpochNumber
bPpuUnlockStakeEpoch :: !(Maybe EpochNumber)
}
deriving Int -> ByronProtocolParametersUpdate -> ShowS
[ByronProtocolParametersUpdate] -> ShowS
ByronProtocolParametersUpdate -> String
(Int -> ByronProtocolParametersUpdate -> ShowS)
-> (ByronProtocolParametersUpdate -> String)
-> ([ByronProtocolParametersUpdate] -> ShowS)
-> Show ByronProtocolParametersUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronProtocolParametersUpdate -> ShowS
showsPrec :: Int -> ByronProtocolParametersUpdate -> ShowS
$cshow :: ByronProtocolParametersUpdate -> String
show :: ByronProtocolParametersUpdate -> String
$cshowList :: [ByronProtocolParametersUpdate] -> ShowS
showList :: [ByronProtocolParametersUpdate] -> ShowS
Show
makeProtocolParametersUpdate
:: ByronProtocolParametersUpdate
-> ProtocolParametersUpdate
makeProtocolParametersUpdate :: ByronProtocolParametersUpdate -> ProtocolParametersUpdate
makeProtocolParametersUpdate ByronProtocolParametersUpdate
apiPpu =
ProtocolParametersUpdate
{ ppuScriptVersion :: Maybe Word16
ppuScriptVersion = ByronProtocolParametersUpdate -> Maybe Word16
bPpuScriptVersion ByronProtocolParametersUpdate
apiPpu
, ppuSlotDuration :: Maybe Natural
ppuSlotDuration = ByronProtocolParametersUpdate -> Maybe Natural
bPpuSlotDuration ByronProtocolParametersUpdate
apiPpu
, ppuMaxBlockSize :: Maybe Natural
ppuMaxBlockSize = ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxBlockSize ByronProtocolParametersUpdate
apiPpu
, ppuMaxHeaderSize :: Maybe Natural
ppuMaxHeaderSize = ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxHeaderSize ByronProtocolParametersUpdate
apiPpu
, ppuMaxTxSize :: Maybe Natural
ppuMaxTxSize = ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxTxSize ByronProtocolParametersUpdate
apiPpu
, ppuMaxProposalSize :: Maybe Natural
ppuMaxProposalSize = ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxProposalSize ByronProtocolParametersUpdate
apiPpu
, ppuMpcThd :: Maybe LovelacePortion
ppuMpcThd = ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuMpcThd ByronProtocolParametersUpdate
apiPpu
, ppuHeavyDelThd :: Maybe LovelacePortion
ppuHeavyDelThd = ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuHeavyDelThd ByronProtocolParametersUpdate
apiPpu
, ppuUpdateVoteThd :: Maybe LovelacePortion
ppuUpdateVoteThd = ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuUpdateVoteThd ByronProtocolParametersUpdate
apiPpu
, ppuUpdateProposalThd :: Maybe LovelacePortion
ppuUpdateProposalThd = ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuUpdateProposalThd ByronProtocolParametersUpdate
apiPpu
, ppuUpdateProposalTTL :: Maybe SlotNumber
ppuUpdateProposalTTL = ByronProtocolParametersUpdate -> Maybe SlotNumber
bPpuUpdateProposalTTL ByronProtocolParametersUpdate
apiPpu
, ppuSoftforkRule :: Maybe SoftforkRule
ppuSoftforkRule = ByronProtocolParametersUpdate -> Maybe SoftforkRule
bPpuSoftforkRule ByronProtocolParametersUpdate
apiPpu
, ppuTxFeePolicy :: Maybe TxFeePolicy
ppuTxFeePolicy = ByronProtocolParametersUpdate -> Maybe TxFeePolicy
bPpuTxFeePolicy ByronProtocolParametersUpdate
apiPpu
, ppuUnlockStakeEpoch :: Maybe EpochNumber
ppuUnlockStakeEpoch = ByronProtocolParametersUpdate -> Maybe EpochNumber
bPpuUnlockStakeEpoch ByronProtocolParametersUpdate
apiPpu
}
toByronLedgerUpdateProposal :: ByronUpdateProposal -> Mempool.GenTx ByronBlock
toByronLedgerUpdateProposal :: ByronUpdateProposal -> GenTx ByronBlock
toByronLedgerUpdateProposal (ByronUpdateProposal AProposal ByteString
proposal) =
UpId -> AProposal ByteString -> GenTx ByronBlock
Mempool.ByronUpdateProposal (AProposal ByteString -> UpId
recoverUpId AProposal ByteString
proposal) AProposal ByteString
proposal
newtype ByronVote = ByronVote {ByronVote -> AVote ByteString
unByronVote :: ByronVote.AVote ByteString}
deriving (ByronVote -> ByronVote -> Bool
(ByronVote -> ByronVote -> Bool)
-> (ByronVote -> ByronVote -> Bool) -> Eq ByronVote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ByronVote -> ByronVote -> Bool
== :: ByronVote -> ByronVote -> Bool
$c/= :: ByronVote -> ByronVote -> Bool
/= :: ByronVote -> ByronVote -> Bool
Eq, Int -> ByronVote -> ShowS
[ByronVote] -> ShowS
ByronVote -> String
(Int -> ByronVote -> ShowS)
-> (ByronVote -> String)
-> ([ByronVote] -> ShowS)
-> Show ByronVote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronVote -> ShowS
showsPrec :: Int -> ByronVote -> ShowS
$cshow :: ByronVote -> String
show :: ByronVote -> String
$cshowList :: [ByronVote] -> ShowS
showList :: [ByronVote] -> ShowS
Show)
instance HasTypeProxy ByronVote where
data AsType ByronVote = AsByronVote
proxyToAsType :: Proxy ByronVote -> AsType ByronVote
proxyToAsType Proxy ByronVote
_ = AsType ByronVote
AsByronVote
instance SerialiseAsRawBytes ByronVote where
serialiseToRawBytes :: ByronVote -> ByteString
serialiseToRawBytes (ByronVote AVote ByteString
vote) = AVote () -> ByteString
forall a. ToCBOR a => a -> ByteString
Binary.serialize' (AVote () -> ByteString) -> AVote () -> ByteString
forall a b. (a -> b) -> a -> b
$ (ByteString -> ()) -> AVote ByteString -> AVote ()
forall a b. (a -> b) -> AVote a -> AVote b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> ByteString -> ()
forall a b. a -> b -> a
const ()) AVote ByteString
vote
deserialiseFromRawBytes :: AsType ByronVote
-> ByteString -> Either SerialiseAsRawBytesError ByronVote
deserialiseFromRawBytes AsType ByronVote
R:AsTypeByronVote
AsByronVote ByteString
bs =
let lBs :: LazyByteString
lBs = ByteString -> LazyByteString
LB.fromStrict ByteString
bs
in case LazyByteString -> Either DecoderError (AVote ByteSpan)
forall a. FromCBOR a => LazyByteString -> Either DecoderError a
Binary.decodeFull LazyByteString
lBs of
Left DecoderError
e -> SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError ByronVote
forall a b. a -> Either a b
Left (SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError ByronVote)
-> SerialiseAsRawBytesError
-> Either SerialiseAsRawBytesError ByronVote
forall a b. (a -> b) -> a -> b
$ String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError (String -> SerialiseAsRawBytesError)
-> String -> SerialiseAsRawBytesError
forall a b. (a -> b) -> a -> b
$ String
"Unable to deserialise ByronVote: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> DecoderError -> String
forall a. Show a => a -> String
show DecoderError
e
Right AVote ByteSpan
vote -> ByronVote -> Either SerialiseAsRawBytesError ByronVote
forall a b. b -> Either a b
Right (ByronVote -> Either SerialiseAsRawBytesError ByronVote)
-> (AVote ByteString -> ByronVote)
-> AVote ByteString
-> Either SerialiseAsRawBytesError ByronVote
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AVote ByteString -> ByronVote
ByronVote (AVote ByteString -> Either SerialiseAsRawBytesError ByronVote)
-> AVote ByteString -> Either SerialiseAsRawBytesError ByronVote
forall a b. (a -> b) -> a -> b
$ AVote ByteSpan -> LazyByteString -> AVote ByteString
annotateVote AVote ByteSpan
vote LazyByteString
lBs
where
annotateVote :: ByronVote.AVote Binary.ByteSpan -> LB.ByteString -> ByronVote.AVote ByteString
annotateVote :: AVote ByteSpan -> LazyByteString -> AVote ByteString
annotateVote AVote ByteSpan
vote LazyByteString
bs' = LazyByteString -> AVote ByteSpan -> AVote ByteString
forall (f :: * -> *).
Functor f =>
LazyByteString -> f ByteSpan -> f ByteString
Binary.annotationBytes LazyByteString
bs' AVote ByteSpan
vote
makeByronVote
:: NetworkId
-> SomeByronSigningKey
-> ByronUpdateProposal
-> Bool
-> ByronVote
makeByronVote :: NetworkId
-> SomeByronSigningKey -> ByronUpdateProposal -> Bool -> ByronVote
makeByronVote NetworkId
nId SomeByronSigningKey
sKey (ByronUpdateProposal AProposal ByteString
proposal) Bool
yesOrNo =
let signingKey :: SigningKey
signingKey = SomeByronSigningKey -> SigningKey
toByronSigningKey SomeByronSigningKey
sKey
nonAnnotatedVote :: ByronVote.AVote ()
nonAnnotatedVote :: AVote ()
nonAnnotatedVote = ProtocolMagicId -> SigningKey -> UpId -> Bool -> AVote ()
mkVote (NetworkId -> ProtocolMagicId
toByronProtocolMagicId NetworkId
nId) SigningKey
signingKey (AProposal ByteString -> UpId
recoverUpId AProposal ByteString
proposal) Bool
yesOrNo
annotatedProposalId :: Binary.Annotated UpId ByteString
annotatedProposalId :: Annotated UpId ByteString
annotatedProposalId =
Version -> Annotated UpId () -> Annotated UpId ByteString
forall a b.
EncCBOR a =>
Version -> Annotated a b -> Annotated a ByteString
Binary.reAnnotate Version
Binary.byronProtVer (Annotated UpId () -> Annotated UpId ByteString)
-> Annotated UpId () -> Annotated UpId ByteString
forall a b. (a -> b) -> a -> b
$ AVote () -> Annotated UpId ()
forall a. AVote a -> Annotated UpId a
ByronVote.aProposalId AVote ()
nonAnnotatedVote
in AVote ByteString -> ByronVote
ByronVote (AVote ByteString -> ByronVote) -> AVote ByteString -> ByronVote
forall a b. (a -> b) -> a -> b
$
AVote ()
nonAnnotatedVote
{ ByronVote.aProposalId = annotatedProposalId
, ByronVote.annotation = Binary.annotation annotatedProposalId
}
toByronLedgertoByronVote :: ByronVote -> Mempool.GenTx ByronBlock
toByronLedgertoByronVote :: ByronVote -> GenTx ByronBlock
toByronLedgertoByronVote (ByronVote AVote ByteString
vote) = VoteId -> AVote ByteString -> GenTx ByronBlock
Mempool.ByronUpdateVote (AVote ByteString -> VoteId
recoverVoteId AVote ByteString
vote) AVote ByteString
vote
applicationName :: Update.ApplicationName
applicationName :: ApplicationName
applicationName = Text -> ApplicationName
Update.ApplicationName Text
"cardano-sl"
applicationVersion :: Update.NumSoftwareVersion
applicationVersion :: NumSoftwareVersion
applicationVersion = NumSoftwareVersion
1
softwareVersion :: Update.SoftwareVersion
softwareVersion :: SoftwareVersion
softwareVersion = ApplicationName -> NumSoftwareVersion -> SoftwareVersion
Update.SoftwareVersion ApplicationName
applicationName NumSoftwareVersion
applicationVersion