content: {-# LANGUAGE RecordWildCards #-}
  
  module Pos.Chain.Update.BlockVersionData
         ( BlockVersionData (..)
         , isBootstrapEraBVD
         , ObftConsensusStrictness (..)
         , ConsensusEra (..)
         , consensusEraBVD
         , obftEraFlagValue
         ) where
  
  import           Universum
  
  import           Control.Monad.Except (MonadError)
  import qualified Data.Aeson.Options as S (defaultOptions)
  import           Data.Aeson.TH (deriveJSON)
  import           Data.SafeCopy (base, deriveSafeCopySimple)
  import           Data.Time.Units (Millisecond)
  import           Formatting (bprint, build, int, (%))
  import qualified Formatting.Buildable as Buildable
  import           Serokell.Data.Memory.Units (Byte, memory)
  import           Text.JSON.Canonical (FromJSON (..), ToJSON (..), fromJSField,
                       mkObject)
  
  import           Pos.Binary.Class (Cons (..), Field (..), deriveSimpleBi)
  import           Pos.Chain.Update.SoftforkRule
  import           Pos.Core.Binary ()
  import           Pos.Core.Common (CoinPortion, ScriptVersion, TxFeePolicy)
  import           Pos.Core.Slotting (EpochIndex (..), FlatSlotId, isBootstrapEra)
  import           Pos.Util.Json.Canonical (SchemaError)
  import           Pos.Util.Orphans ()
  
  -- | Data which is associated with 'BlockVersion'.
  data BlockVersionData = BlockVersionData
      { bvdScriptVersion     :: !ScriptVersion
      , bvdSlotDuration      :: !Millisecond
      , bvdMaxBlockSize      :: !Byte
      , bvdMaxHeaderSize     :: !Byte
      , bvdMaxTxSize         :: !Byte
      , bvdMaxProposalSize   :: !Byte
      , bvdMpcThd            :: !CoinPortion
      , bvdHeavyDelThd       :: !CoinPortion
      , bvdUpdateVoteThd     :: !CoinPortion
      , bvdUpdateProposalThd :: !CoinPortion
      , bvdUpdateImplicit    :: !FlatSlotId
      , bvdSoftforkRule      :: !SoftforkRule
      , bvdTxFeePolicy       :: !TxFeePolicy
      , bvdUnlockStakeEpoch  :: !EpochIndex
      } deriving (Show, Eq, Ord, Generic, Typeable)
  
  instance NFData BlockVersionData where
  
  instance Buildable BlockVersionData where
      build BlockVersionData {..} =
        bprint ("{ script version: "%build%
                ", slot duration: "%int%" mcs"%
                ", block size limit: "%memory%
                ", header size limit: "%memory%
                ", tx size limit: "%memory%
                ", proposal size limit: "%memory%
                ", mpc threshold: "%build%
                ", heavyweight delegation threshold: "%build%
                ", update vote threshold: "%build%
                ", update proposal threshold: "%build%
                ", update implicit period: "%int%" slots"%
                ", softfork rule: "%build%
                ", tx fee policy: "%build%
                ", unlock stake epoch: "%build%
                " }")
          bvdScriptVersion
          bvdSlotDuration
          bvdMaxBlockSize
          bvdMaxHeaderSize
          bvdMaxTxSize
          bvdMaxProposalSize
          bvdMpcThd
          bvdHeavyDelThd
          bvdUpdateVoteThd
          bvdUpdateProposalThd
          bvdUpdateImplicit
          bvdSoftforkRule
          bvdTxFeePolicy
          bvdUnlockStakeEpoch
  
  instance Monad m => ToJSON m BlockVersionData where
      toJSON (BlockVersionData scriptVersion slotDuration maxBlockSize maxHeaderSize maxTxSize maxProposalSize mpcThd heavyDelThd updateVoteThd updateProposalThd updateImplicit softforkRule txFeePolicy unlockStakeEpoch) =
          mkObject
              [ ("scriptVersion", toJSON scriptVersion)
              , ("slotDuration", toJSON slotDuration)
              , ("maxBlockSize", toJSON maxBlockSize)
              , ("maxHeaderSize", toJSON maxHeaderSize)
              , ("maxTxSize", toJSON maxTxSize)
              , ("maxProposalSize", toJSON maxProposalSize)
              , ("mpcThd", toJSON mpcThd)
              , ("heavyDelThd", toJSON heavyDelThd)
              , ("updateVoteThd", toJSON updateVoteThd)
              , ("updateProposalThd", toJSON updateProposalThd)
              , ("updateImplicit", toJSON updateImplicit)
              , ("softforkRule", toJSON softforkRule)
              , ("txFeePolicy", toJSON txFeePolicy)
              , ("unlockStakeEpoch", toJSON unlockStakeEpoch)
              ]
  
  instance MonadError SchemaError m => FromJSON m BlockVersionData where
      fromJSON obj = do
          bvdScriptVersion <- fromJSField obj "scriptVersion"
          bvdSlotDuration <- fromJSField obj "slotDuration"
          bvdMaxBlockSize <- fromJSField obj "maxBlockSize"
          bvdMaxHeaderSize <- fromJSField obj "maxHeaderSize"
          bvdMaxTxSize <- fromJSField obj "maxTxSize"
          bvdMaxProposalSize <- fromJSField obj "maxProposalSize"
          bvdMpcThd <- fromJSField obj "mpcThd"
          bvdHeavyDelThd <- fromJSField obj "heavyDelThd"
          bvdUpdateVoteThd <- fromJSField obj "updateVoteThd"
          bvdUpdateProposalThd <- fromJSField obj "updateProposalThd"
          bvdUpdateImplicit <- fromJSField obj "updateImplicit"
          bvdSoftforkRule <- fromJSField obj "softforkRule"
          bvdTxFeePolicy <- fromJSField obj "txFeePolicy"
          bvdUnlockStakeEpoch <- fromJSField obj "unlockStakeEpoch"
          return BlockVersionData {..}
  
  deriveJSON S.defaultOptions ''BlockVersionData
  
  -- | Version of 'isBootstrapEra' which takes 'BlockVersionData'
  -- instead of unlock stake epoch.
  isBootstrapEraBVD :: BlockVersionData -> EpochIndex -> Bool
  isBootstrapEraBVD adoptedBVD = isBootstrapEra (bvdUnlockStakeEpoch adoptedBVD)
  
  -- | This is a magic value which signifies that we are in the OBFT era.
  -- Since we are no longer decentralizing this codebase, we can repurpose
  -- this field to signify the shift to OBFT.
  obftEraFlagValue :: EpochIndex
  obftEraFlagValue = EpochIndex 9999999999999999999
  
  data ObftConsensusStrictness = ObftStrict | ObftLenient
      deriving (Eq, Show, Generic)
  
  instance NFData ObftConsensusStrictness
  
  data ConsensusEra = Original | OBFT ObftConsensusStrictness
      deriving (Eq, Show, Generic)
  
  instance NFData ConsensusEra
  
  -- | This function uses the repurposed field `bvdUnlockStakeEpoch` to
  -- tell us whether we are in the Original or OBFT consensus eras.
  consensusEraBVD :: BlockVersionData -> ConsensusEra
  consensusEraBVD bvd = if obftEraFlagValue == bvdUnlockStakeEpoch bvd
                           then OBFT ObftLenient
                           else Original
  
  deriveSimpleBi ''BlockVersionData [
      Cons 'BlockVersionData [
          Field [| bvdScriptVersion     :: ScriptVersion |],
          Field [| bvdSlotDuration      :: Millisecond   |],
          Field [| bvdMaxBlockSize      :: Byte          |],
          Field [| bvdMaxHeaderSize     :: Byte          |],
          Field [| bvdMaxTxSize         :: Byte          |],
          Field [| bvdMaxProposalSize   :: Byte          |],
          Field [| bvdMpcThd            :: CoinPortion   |],
          Field [| bvdHeavyDelThd       :: CoinPortion   |],
          Field [| bvdUpdateVoteThd     :: CoinPortion   |],
          Field [| bvdUpdateProposalThd :: CoinPortion   |],
          Field [| bvdUpdateImplicit    :: FlatSlotId    |],
          Field [| bvdSoftforkRule      :: SoftforkRule  |],
          Field [| bvdTxFeePolicy       :: TxFeePolicy   |],
          Field [| bvdUnlockStakeEpoch  :: EpochIndex    |]
      ]]
  
  deriveSafeCopySimple 0 'base ''BlockVersionData
  