{-# 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.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 { 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
/= :: ByronUpdateProposal -> ByronUpdateProposal -> Bool
$c/= :: ByronUpdateProposal -> ByronUpdateProposal -> Bool
== :: ByronUpdateProposal -> ByronUpdateProposal -> Bool
$c== :: 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
showList :: [ByronUpdateProposal] -> ShowS
$cshowList :: [ByronUpdateProposal] -> ShowS
show :: ByronUpdateProposal -> String
$cshow :: ByronUpdateProposal -> String
showsPrec :: Int -> ByronUpdateProposal -> ShowS
$cshowsPrec :: Int -> 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 -> Maybe ByronUpdateProposal
deserialiseFromRawBytes AsType ByronUpdateProposal
AsByronUpdateProposal ByteString
bs =
    let lBs :: ByteString
lBs = ByteString -> ByteString
LB.fromStrict ByteString
bs
    in case ByteString -> Either DecoderError (AProposal ByteSpan)
forall a. FromCBOR a => ByteString -> Either DecoderError a
Binary.decodeFull ByteString
lBs of
        Left DecoderError
_deserFail -> Maybe ByronUpdateProposal
forall a. Maybe a
Nothing
        Right AProposal ByteSpan
proposal -> ByronUpdateProposal -> Maybe ByronUpdateProposal
forall a. a -> Maybe a
Just (AProposal ByteString -> ByronUpdateProposal
ByronUpdateProposal AProposal ByteString
proposal')
          where
            proposal' :: AProposal ByteString
            proposal' :: AProposal ByteString
proposal' = ByteString -> AProposal ByteSpan -> AProposal ByteString
forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
Binary.annotationBytes ByteString
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 = Annotated ProposalBody () -> Annotated ProposalBody ByteString
forall a b. ToCBOR a => Annotated a b -> Annotated a ByteString
Binary.reAnnotate (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 { $sel:aBody:AProposal :: Annotated ProposalBody ByteString
aBody = Annotated ProposalBody ByteString
annotatedPropBody
                              , $sel:annotation:AProposal :: ByteString
annotation = AProposal () -> ByteString
forall a. ToCBOR a => a -> ByteString
Binary.serialize' AProposal ()
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)
      -- ^ 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.
    , ByronProtocolParametersUpdate -> Maybe Natural
bPpuSlotDuration      :: !(Maybe Natural)
      -- ^ Slot duration in milliseconds.
    , ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxBlockSize      :: !(Maybe Natural)
      -- ^ Maximum block size in bytes.
    , ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxHeaderSize     :: !(Maybe Natural)
      -- ^ Maximum block header size in bytes.
    , ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxTxSize         :: !(Maybe Natural)
      -- ^ Maximum transaction size in bytes.
    , ByronProtocolParametersUpdate -> Maybe Natural
bPpuMaxProposalSize   :: !(Maybe Natural)
      -- ^ Maximum update proposal size in bytes.
    , ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuMpcThd            :: !(Maybe LovelacePortion)
    , ByronProtocolParametersUpdate -> 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.
    , ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuUpdateVoteThd     :: !(Maybe LovelacePortion)
    , ByronProtocolParametersUpdate -> Maybe LovelacePortion
bPpuUpdateProposalThd :: !(Maybe LovelacePortion)
    , ByronProtocolParametersUpdate -> Maybe SlotNumber
bPpuUpdateProposalTTL :: !(Maybe SlotNumber)
    , ByronProtocolParametersUpdate -> Maybe SoftforkRule
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.
    , ByronProtocolParametersUpdate -> Maybe TxFeePolicy
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.
    , ByronProtocolParametersUpdate -> Maybe EpochNumber
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 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
showList :: [ByronProtocolParametersUpdate] -> ShowS
$cshowList :: [ByronProtocolParametersUpdate] -> ShowS
show :: ByronProtocolParametersUpdate -> String
$cshow :: ByronProtocolParametersUpdate -> String
showsPrec :: Int -> ByronProtocolParametersUpdate -> ShowS
$cshowsPrec :: Int -> ByronProtocolParametersUpdate -> ShowS
Show

makeProtocolParametersUpdate
  :: ByronProtocolParametersUpdate
  -> ProtocolParametersUpdate
makeProtocolParametersUpdate :: ByronProtocolParametersUpdate -> ProtocolParametersUpdate
makeProtocolParametersUpdate ByronProtocolParametersUpdate
apiPpu =
  ProtocolParametersUpdate :: Maybe Word16
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe LovelacePortion
-> Maybe SlotNumber
-> Maybe SoftforkRule
-> Maybe TxFeePolicy
-> Maybe EpochNumber
-> ProtocolParametersUpdate
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

-- | Byron era votes

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
/= :: ByronVote -> ByronVote -> Bool
$c/= :: ByronVote -> ByronVote -> Bool
== :: ByronVote -> ByronVote -> Bool
$c== :: 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
showList :: [ByronVote] -> ShowS
$cshowList :: [ByronVote] -> ShowS
show :: ByronVote -> String
$cshow :: ByronVote -> String
showsPrec :: Int -> ByronVote -> ShowS
$cshowsPrec :: Int -> 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 (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 -> Maybe ByronVote
deserialiseFromRawBytes AsType ByronVote
AsByronVote ByteString
bs =
    let lBs :: ByteString
lBs = ByteString -> ByteString
LB.fromStrict ByteString
bs
    in case ByteString -> Either DecoderError (AVote ByteSpan)
forall a. FromCBOR a => ByteString -> Either DecoderError a
Binary.decodeFull ByteString
lBs of
         Left DecoderError
_deserFail -> Maybe ByronVote
forall a. Maybe a
Nothing
         Right AVote ByteSpan
vote -> ByronVote -> Maybe ByronVote
forall a. a -> Maybe a
Just (ByronVote -> Maybe ByronVote)
-> (AVote ByteString -> ByronVote)
-> AVote ByteString
-> Maybe ByronVote
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AVote ByteString -> ByronVote
ByronVote (AVote ByteString -> Maybe ByronVote)
-> AVote ByteString -> Maybe ByronVote
forall a b. (a -> b) -> a -> b
$ AVote ByteSpan -> ByteString -> AVote ByteString
annotateVote AVote ByteSpan
vote ByteString
lBs
   where
    annotateVote :: ByronVote.AVote Binary.ByteSpan -> LB.ByteString -> ByronVote.AVote ByteString
    annotateVote :: AVote ByteSpan -> ByteString -> AVote ByteString
annotateVote AVote ByteSpan
vote ByteString
bs' = ByteString -> AVote ByteSpan -> AVote ByteString
forall (f :: * -> *).
Functor f =>
ByteString -> f ByteSpan -> f ByteString
Binary.annotationBytes ByteString
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 = Annotated UpId () -> Annotated UpId ByteString
forall a b. ToCBOR a => Annotated a b -> Annotated a ByteString
Binary.reAnnotate (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 { aProposalId :: Annotated UpId ByteString
ByronVote.aProposalId = Annotated UpId ByteString
annotatedProposalId
                          , annotation :: ByteString
ByronVote.annotation = Annotated UpId ByteString -> ByteString
forall b a. Annotated b a -> a
Binary.annotation Annotated UpId ByteString
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