{-# 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           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.Keys.Byron
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
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
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) = 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 :: ByteString
lBs = ByteString -> ByteString
LB.fromStrict ByteString
bs
    in case forall a. FromCBOR a => ByteString -> Either DecoderError a
Binary.decodeFull ByteString
lBs of
        Left DecoderError
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError forall a b. (a -> b) -> a -> b
$ String
"Unable to deserialise ByronUpdateProposal: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DecoderError
e
        Right AProposal ByteSpan
proposal -> forall a b. b -> Either a b
Right (AProposal ByteString -> ByronUpdateProposal
ByronUpdateProposal AProposal ByteString
proposal')
          where
            proposal' :: AProposal ByteString
            proposal' :: AProposal ByteString
proposal' = 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 = forall a b. ToCBOR a => Annotated a b -> Annotated a ByteString
Binary.reAnnotate forall a b. (a -> b) -> a -> b
$ forall a. AProposal a -> Annotated ProposalBody a
aBody AProposal ()
nonAnnotatedProposal
  in AProposal ByteString -> ByronUpdateProposal
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 = 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 = forall k a. k -> a -> Map k a
M.singleton SystemTag
sysTag InstallerHash
insHash

   noPassSigningKey :: SafeSigner
   noPassSigningKey :: SafeSigner
noPassSigningKey = SigningKey -> SafeSigner
noPassSafeSigner 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
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
    { 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
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
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) = forall a. ToCBOR a => a -> ByteString
Binary.serialize' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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 :: ByteString
lBs = ByteString -> ByteString
LB.fromStrict ByteString
bs
    in case forall a. FromCBOR a => ByteString -> Either DecoderError a
Binary.decodeFull ByteString
lBs of
         Left DecoderError
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String -> SerialiseAsRawBytesError
SerialiseAsRawBytesError forall a b. (a -> b) -> a -> b
$ String
"Unable to deserialise ByronVote: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show DecoderError
e
         Right AVote ByteSpan
vote -> forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. AVote ByteString -> ByronVote
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' = 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 = forall a b. ToCBOR a => Annotated a b -> Annotated a ByteString
Binary.reAnnotate forall a b. (a -> b) -> a -> b
$ forall a. AVote a -> Annotated UpId a
ByronVote.aProposalId AVote ()
nonAnnotatedVote
  in AVote ByteString -> ByronVote
ByronVote
       forall a b. (a -> b) -> a -> b
$ AVote ()
nonAnnotatedVote { aProposalId :: Annotated UpId ByteString
ByronVote.aProposalId = Annotated UpId ByteString
annotatedProposalId
                          , annotation :: ByteString
ByronVote.annotation = 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