{-# LANGUAGE TypeFamilies #-}

-- | Special Cole 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 Bcc.Api.SpecialCole
  ( ColeUpdateProposal(..),
    ColeProtocolParametersUpdate(..),
    AsType(AsColeUpdateProposal, AsColeVote),
    makeProtocolParametersUpdate,
    toColeLedgerUpdateProposal,
    ColeVote(..),
    makeColeUpdateProposal,
    makeColeVote,
    toColeLedgertoColeVote,
  ) 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           Bcc.Api.HasTypeProxy
import           Bcc.Api.KeysCole
import           Bcc.Api.NetworkId (NetworkId, toColeProtocolMagicId)
import           Bcc.Api.SerialiseRaw

import qualified Bcc.Binary as Binary
import           Bcc.Chain.Common (EntropicPortion, TxFeePolicy)
import           Bcc.Chain.Slotting
import           Bcc.Chain.Update (AProposal (aBody, annotation), InstallerHash,
                     ProposalBody (ProposalBody), ProtocolParametersUpdate (..), ProtocolVersion,
                     SoftforkRule, SoftwareVersion, SystemTag, UpId, mkVote, recoverUpId,
                     recoverVoteId, signProposal)
import qualified Bcc.Chain.Update.Vote as ColeVote
import           Bcc.Crypto (SafeSigner, noPassSafeSigner)

import           Shardagnostic.Consensus.Cole.Ledger.Block (ColeBlock)
import qualified Shardagnostic.Consensus.Cole.Ledger.Mempool as Mempool

{- HLINT ignore "Use void" -}

-- | Cole era update proposal

newtype ColeUpdateProposal =
    ColeUpdateProposal { ColeUpdateProposal -> AProposal ByteString
unColeUpdateProposal :: AProposal ByteString}
  deriving (ColeUpdateProposal -> ColeUpdateProposal -> Bool
(ColeUpdateProposal -> ColeUpdateProposal -> Bool)
-> (ColeUpdateProposal -> ColeUpdateProposal -> Bool)
-> Eq ColeUpdateProposal
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColeUpdateProposal -> ColeUpdateProposal -> Bool
$c/= :: ColeUpdateProposal -> ColeUpdateProposal -> Bool
== :: ColeUpdateProposal -> ColeUpdateProposal -> Bool
$c== :: ColeUpdateProposal -> ColeUpdateProposal -> Bool
Eq, Int -> ColeUpdateProposal -> ShowS
[ColeUpdateProposal] -> ShowS
ColeUpdateProposal -> String
(Int -> ColeUpdateProposal -> ShowS)
-> (ColeUpdateProposal -> String)
-> ([ColeUpdateProposal] -> ShowS)
-> Show ColeUpdateProposal
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColeUpdateProposal] -> ShowS
$cshowList :: [ColeUpdateProposal] -> ShowS
show :: ColeUpdateProposal -> String
$cshow :: ColeUpdateProposal -> String
showsPrec :: Int -> ColeUpdateProposal -> ShowS
$cshowsPrec :: Int -> ColeUpdateProposal -> ShowS
Show)

instance HasTypeProxy ColeUpdateProposal where
  data AsType ColeUpdateProposal = AsColeUpdateProposal
  proxyToAsType :: Proxy ColeUpdateProposal -> AsType ColeUpdateProposal
proxyToAsType Proxy ColeUpdateProposal
_ = AsType ColeUpdateProposal
AsColeUpdateProposal

instance SerialiseAsRawBytes ColeUpdateProposal where
  serialiseToRawBytes :: ColeUpdateProposal -> ByteString
serialiseToRawBytes (ColeUpdateProposal AProposal ByteString
proposal) = AProposal ByteString -> ByteString
forall a. AProposal a -> a
annotation AProposal ByteString
proposal
  deserialiseFromRawBytes :: AsType ColeUpdateProposal -> ByteString -> Maybe ColeUpdateProposal
deserialiseFromRawBytes AsType ColeUpdateProposal
AsColeUpdateProposal 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 ColeUpdateProposal
forall a. Maybe a
Nothing
        Right AProposal ByteSpan
proposal -> ColeUpdateProposal -> Maybe ColeUpdateProposal
forall a. a -> Maybe a
Just (AProposal ByteString -> ColeUpdateProposal
ColeUpdateProposal 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

makeColeUpdateProposal
  :: NetworkId
  -> ProtocolVersion
  -> SoftwareVersion
  -> SystemTag
  -> InstallerHash
  -> SomeColeSigningKey
  -> ColeProtocolParametersUpdate
  -> ColeUpdateProposal
makeColeUpdateProposal :: NetworkId
-> ProtocolVersion
-> SoftwareVersion
-> SystemTag
-> InstallerHash
-> SomeColeSigningKey
-> ColeProtocolParametersUpdate
-> ColeUpdateProposal
makeColeUpdateProposal NetworkId
nId ProtocolVersion
pVer SoftwareVersion
sVer SystemTag
sysTag InstallerHash
insHash
                          SomeColeSigningKey
bWit ColeProtocolParametersUpdate
paramsToUpdate =
  let nonAnnotatedProposal :: AProposal ()
      nonAnnotatedProposal :: AProposal ()
nonAnnotatedProposal = ProtocolMagicId -> ProposalBody -> SafeSigner -> AProposal ()
signProposal (NetworkId -> ProtocolMagicId
toColeProtocolMagicId 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 -> ColeUpdateProposal
ColeUpdateProposal
       (AProposal ByteString -> ColeUpdateProposal)
-> AProposal ByteString -> ColeUpdateProposal
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
$ SomeColeSigningKey -> SigningKey
toColeSigningKey SomeColeSigningKey
bWit

   protocolParamsUpdate :: ProtocolParametersUpdate
   protocolParamsUpdate :: ProtocolParametersUpdate
protocolParamsUpdate = ColeProtocolParametersUpdate -> ProtocolParametersUpdate
makeProtocolParametersUpdate ColeProtocolParametersUpdate
paramsToUpdate

data ColeProtocolParametersUpdate =
  ColeProtocolParametersUpdate
    { ColeProtocolParametersUpdate -> Maybe Word16
bPpuScriptVersion     :: !(Maybe Word16)
      -- ^ Redundant. This was meant to be the version of the
      -- Zerepoch smart contract language, however, there are no
      -- smart contracts nor scripts in the Cole era.
    , ColeProtocolParametersUpdate -> Maybe Natural
bPpuSlotDuration      :: !(Maybe Natural)
      -- ^ Slot duration in milliseconds.
    , ColeProtocolParametersUpdate -> Maybe Natural
bPpuMaxBlockSize      :: !(Maybe Natural)
      -- ^ Maximum block size in bytes.
    , ColeProtocolParametersUpdate -> Maybe Natural
bPpuMaxHeaderSize     :: !(Maybe Natural)
      -- ^ Maximum block header size in bytes.
    , ColeProtocolParametersUpdate -> Maybe Natural
bPpuMaxTxSize         :: !(Maybe Natural)
      -- ^ Maxiumum transaction size in bytes.
    , ColeProtocolParametersUpdate -> Maybe Natural
bPpuMaxProposalSize   :: !(Maybe Natural)
      -- ^ Maximum update proposal size in bytes.
    , ColeProtocolParametersUpdate -> Maybe EntropicPortion
bPpuMpcThd            :: !(Maybe EntropicPortion)
    , ColeProtocolParametersUpdate -> Maybe EntropicPortion
bPpuHeavyDelThd       :: !(Maybe EntropicPortion)
      -- ^ Heavyweight delegation threshold. The delegate (i.e stakeholder)
      -- must possess no less than this threshold of stake in order to participate
      -- in heavyweight delegation.
    , ColeProtocolParametersUpdate -> Maybe EntropicPortion
bPpuUpdateVoteThd     :: !(Maybe EntropicPortion)
    , ColeProtocolParametersUpdate -> Maybe EntropicPortion
bPpuUpdateProposalThd :: !(Maybe EntropicPortion)
    , ColeProtocolParametersUpdate -> Maybe SlotNumber
bPpuUpdateProposalTTL :: !(Maybe SlotNumber)
    , ColeProtocolParametersUpdate -> 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.
    , ColeProtocolParametersUpdate -> 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.
    , ColeProtocolParametersUpdate -> Maybe EpochNumber
bPpuUnlockStakeEpoch  :: !(Maybe EpochNumber)
      -- ^ This has been re-purposed for unlocking the ShardagnosticBFT logic in the software.
      -- Relevant: [CDEC-610](https://tbco.myjetbrains.com/youtrack/issue/CDEC-610)
    } deriving Int -> ColeProtocolParametersUpdate -> ShowS
[ColeProtocolParametersUpdate] -> ShowS
ColeProtocolParametersUpdate -> String
(Int -> ColeProtocolParametersUpdate -> ShowS)
-> (ColeProtocolParametersUpdate -> String)
-> ([ColeProtocolParametersUpdate] -> ShowS)
-> Show ColeProtocolParametersUpdate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColeProtocolParametersUpdate] -> ShowS
$cshowList :: [ColeProtocolParametersUpdate] -> ShowS
show :: ColeProtocolParametersUpdate -> String
$cshow :: ColeProtocolParametersUpdate -> String
showsPrec :: Int -> ColeProtocolParametersUpdate -> ShowS
$cshowsPrec :: Int -> ColeProtocolParametersUpdate -> ShowS
Show

makeProtocolParametersUpdate
  :: ColeProtocolParametersUpdate
  -> ProtocolParametersUpdate
makeProtocolParametersUpdate :: ColeProtocolParametersUpdate -> ProtocolParametersUpdate
makeProtocolParametersUpdate ColeProtocolParametersUpdate
apiPpu =
  ProtocolParametersUpdate :: Maybe Word16
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe Natural
-> Maybe EntropicPortion
-> Maybe EntropicPortion
-> Maybe EntropicPortion
-> Maybe EntropicPortion
-> Maybe SlotNumber
-> Maybe SoftforkRule
-> Maybe TxFeePolicy
-> Maybe EpochNumber
-> ProtocolParametersUpdate
ProtocolParametersUpdate
    { ppuScriptVersion :: Maybe Word16
ppuScriptVersion = ColeProtocolParametersUpdate -> Maybe Word16
bPpuScriptVersion ColeProtocolParametersUpdate
apiPpu
    , ppuSlotDuration :: Maybe Natural
ppuSlotDuration = ColeProtocolParametersUpdate -> Maybe Natural
bPpuSlotDuration ColeProtocolParametersUpdate
apiPpu
    , ppuMaxBlockSize :: Maybe Natural
ppuMaxBlockSize = ColeProtocolParametersUpdate -> Maybe Natural
bPpuMaxBlockSize ColeProtocolParametersUpdate
apiPpu
    , ppuMaxHeaderSize :: Maybe Natural
ppuMaxHeaderSize = ColeProtocolParametersUpdate -> Maybe Natural
bPpuMaxHeaderSize ColeProtocolParametersUpdate
apiPpu
    , ppuMaxTxSize :: Maybe Natural
ppuMaxTxSize = ColeProtocolParametersUpdate -> Maybe Natural
bPpuMaxTxSize ColeProtocolParametersUpdate
apiPpu
    , ppuMaxProposalSize :: Maybe Natural
ppuMaxProposalSize = ColeProtocolParametersUpdate -> Maybe Natural
bPpuMaxProposalSize ColeProtocolParametersUpdate
apiPpu
    , ppuMpcThd :: Maybe EntropicPortion
ppuMpcThd = ColeProtocolParametersUpdate -> Maybe EntropicPortion
bPpuMpcThd ColeProtocolParametersUpdate
apiPpu
    , ppuHeavyDelThd :: Maybe EntropicPortion
ppuHeavyDelThd = ColeProtocolParametersUpdate -> Maybe EntropicPortion
bPpuHeavyDelThd ColeProtocolParametersUpdate
apiPpu
    , ppuUpdateVoteThd :: Maybe EntropicPortion
ppuUpdateVoteThd = ColeProtocolParametersUpdate -> Maybe EntropicPortion
bPpuUpdateVoteThd ColeProtocolParametersUpdate
apiPpu
    , ppuUpdateProposalThd :: Maybe EntropicPortion
ppuUpdateProposalThd = ColeProtocolParametersUpdate -> Maybe EntropicPortion
bPpuUpdateProposalThd ColeProtocolParametersUpdate
apiPpu
    , ppuUpdateProposalTTL :: Maybe SlotNumber
ppuUpdateProposalTTL = ColeProtocolParametersUpdate -> Maybe SlotNumber
bPpuUpdateProposalTTL ColeProtocolParametersUpdate
apiPpu
    , ppuSoftforkRule :: Maybe SoftforkRule
ppuSoftforkRule = ColeProtocolParametersUpdate -> Maybe SoftforkRule
bPpuSoftforkRule ColeProtocolParametersUpdate
apiPpu
    , ppuTxFeePolicy :: Maybe TxFeePolicy
ppuTxFeePolicy = ColeProtocolParametersUpdate -> Maybe TxFeePolicy
bPpuTxFeePolicy ColeProtocolParametersUpdate
apiPpu
    , ppuUnlockStakeEpoch :: Maybe EpochNumber
ppuUnlockStakeEpoch = ColeProtocolParametersUpdate -> Maybe EpochNumber
bPpuUnlockStakeEpoch ColeProtocolParametersUpdate
apiPpu
    }

toColeLedgerUpdateProposal :: ColeUpdateProposal -> Mempool.GenTx ColeBlock
toColeLedgerUpdateProposal :: ColeUpdateProposal -> GenTx ColeBlock
toColeLedgerUpdateProposal (ColeUpdateProposal AProposal ByteString
proposal) =
  UpId -> AProposal ByteString -> GenTx ColeBlock
Mempool.ColeUpdateProposal (AProposal ByteString -> UpId
recoverUpId AProposal ByteString
proposal) AProposal ByteString
proposal

-- | Cole era votes

newtype ColeVote = ColeVote { ColeVote -> AVote ByteString
unColeVote :: ColeVote.AVote ByteString }
  deriving (ColeVote -> ColeVote -> Bool
(ColeVote -> ColeVote -> Bool)
-> (ColeVote -> ColeVote -> Bool) -> Eq ColeVote
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ColeVote -> ColeVote -> Bool
$c/= :: ColeVote -> ColeVote -> Bool
== :: ColeVote -> ColeVote -> Bool
$c== :: ColeVote -> ColeVote -> Bool
Eq, Int -> ColeVote -> ShowS
[ColeVote] -> ShowS
ColeVote -> String
(Int -> ColeVote -> ShowS)
-> (ColeVote -> String) -> ([ColeVote] -> ShowS) -> Show ColeVote
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ColeVote] -> ShowS
$cshowList :: [ColeVote] -> ShowS
show :: ColeVote -> String
$cshow :: ColeVote -> String
showsPrec :: Int -> ColeVote -> ShowS
$cshowsPrec :: Int -> ColeVote -> ShowS
Show)

instance HasTypeProxy ColeVote where
  data AsType ColeVote = AsColeVote
  proxyToAsType :: Proxy ColeVote -> AsType ColeVote
proxyToAsType Proxy ColeVote
_ = AsType ColeVote
AsColeVote

instance SerialiseAsRawBytes ColeVote where
  serialiseToRawBytes :: ColeVote -> ByteString
serialiseToRawBytes (ColeVote 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 ColeVote -> ByteString -> Maybe ColeVote
deserialiseFromRawBytes AsType ColeVote
AsColeVote 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 ColeVote
forall a. Maybe a
Nothing
         Right AVote ByteSpan
vote -> ColeVote -> Maybe ColeVote
forall a. a -> Maybe a
Just (ColeVote -> Maybe ColeVote)
-> (AVote ByteString -> ColeVote)
-> AVote ByteString
-> Maybe ColeVote
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AVote ByteString -> ColeVote
ColeVote (AVote ByteString -> Maybe ColeVote)
-> AVote ByteString -> Maybe ColeVote
forall a b. (a -> b) -> a -> b
$ AVote ByteSpan -> ByteString -> AVote ByteString
annotateVote AVote ByteSpan
vote ByteString
lBs
   where
    annotateVote :: ColeVote.AVote Binary.ByteSpan -> LB.ByteString -> ColeVote.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


makeColeVote
  :: NetworkId
  -> SomeColeSigningKey
  -> ColeUpdateProposal
  -> Bool
  -> ColeVote
makeColeVote :: NetworkId
-> SomeColeSigningKey -> ColeUpdateProposal -> Bool -> ColeVote
makeColeVote NetworkId
nId SomeColeSigningKey
sKey (ColeUpdateProposal AProposal ByteString
proposal) Bool
yesOrNo =
  let signingKey :: SigningKey
signingKey = SomeColeSigningKey -> SigningKey
toColeSigningKey SomeColeSigningKey
sKey
      nonAnnotatedVote :: ColeVote.AVote ()
      nonAnnotatedVote :: AVote ()
nonAnnotatedVote = ProtocolMagicId -> SigningKey -> UpId -> Bool -> AVote ()
mkVote (NetworkId -> ProtocolMagicId
toColeProtocolMagicId 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
ColeVote.aProposalId AVote ()
nonAnnotatedVote
  in AVote ByteString -> ColeVote
ColeVote
       (AVote ByteString -> ColeVote) -> AVote ByteString -> ColeVote
forall a b. (a -> b) -> a -> b
$ AVote ()
nonAnnotatedVote { aProposalId :: Annotated UpId ByteString
ColeVote.aProposalId = Annotated UpId ByteString
annotatedProposalId
                          , annotation :: ByteString
ColeVote.annotation = Annotated UpId ByteString -> ByteString
forall b a. Annotated b a -> a
Binary.annotation Annotated UpId ByteString
annotatedProposalId
                          }

toColeLedgertoColeVote :: ColeVote -> Mempool.GenTx ColeBlock
toColeLedgertoColeVote :: ColeVote -> GenTx ColeBlock
toColeLedgertoColeVote (ColeVote AVote ByteString
vote) = VoteId -> AVote ByteString -> GenTx ColeBlock
Mempool.ColeUpdateVote (AVote ByteString -> VoteId
recoverVoteId AVote ByteString
vote) AVote ByteString
vote