{-# LANGUAGE Rank2Types      #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeOperators   #-}

-- | Version related checks of proposal:
-- * BlockVersionState
-- * BlockVersion
-- * Software version

module Pos.DB.Update.Poll.Logic.Version
       ( verifyAndApplyProposalBVS
       , verifyBlockAndSoftwareVersions
       ) where

import           Control.Monad.Except (MonadError, throwError)
import           Universum

import           Pos.Chain.Update (BlockVersionData (..),
                     BlockVersionModifier (..), BlockVersionState (..),
                     MonadPoll (..), MonadPollRead (..), NumSoftwareVersion,
                     PollVerFailure (..), SoftwareVersion (..), UpId,
                     UpdateProposal (..))
import           Pos.Core (EpochIndex)
import           Pos.DB.Update.Poll.Logic.Base (BVChange (..), canBeProposedBV,
                     verifyNextBVMod)


-- Here we add check that block version data from proposal is consistent
-- with current data and add new 'BlockVersionState' if this is a new
-- version.
--
-- The following checks are performed:
--
-- 1. We check that versions and constants from proposal are the same as
-- versions and constants from other proposals with the same block version.
--
-- 2. But if the proposal has a new 'BlockVersion', we check that
-- a) its 'ScriptVersion' is @lastScriptVersion + 1@, and
-- b) its 'maxBlockSize' is at most 2× the previous block size.
-- c) its 'unlockStakeEpoch' does not affect past transactions. That is, we
--    cannot change the end of the boostrap era post factum.
verifyAndApplyProposalBVS
    :: forall m. (MonadError PollVerFailure m, MonadPoll m)
    => UpId
    -> EpochIndex -- block epoch index
    -> UpdateProposal
    -> m ()
verifyAndApplyProposalBVS upId epoch up =
    getBVDataOrModifier >>= \case
        -- This block version is adopted, so we check
        -- 'BlockVersionModifier' against the adopted 'BlockVersionData'.
        Just (Left adoptedBVD) -> unless (bvmMatchesBVD proposedBVM adoptedBVD) $
           throwError
               $ PollAlreadyAdoptedDiffers adoptedBVD proposedBVM upId
        -- This block version is competing, so we check that
        -- 'BlockVersionModifier' is the same.
        Just (Right competingBVM) -> unless (competingBVM == proposedBVM) $
            throwError
                $ PollInconsistentBVM competingBVM proposedBVM upId
        -- This block version isn't known, so we can add it after doing
        -- checks against the previous known block version state
        Nothing -> do
            let newBVS = BlockVersionState
                  { bvsModifier          = proposedBVM
                  , bvsConfirmedEpoch    = Nothing
                  , bvsIssuersStable     = mempty
                  , bvsIssuersUnstable   = mempty
                  , bvsLastBlockStable   = Nothing
                  , bvsLastBlockUnstable = Nothing
                  }
            oldBVD <- getAdoptedBVData
            verifyNextBVMod upId epoch oldBVD proposedBVM
            putBVState (upBlockVersion up) newBVS
  where
    proposedBV = upBlockVersion up
    proposedBVM = upBlockVersionMod up
    -- We have three different cases:
    --
    -- • proposed 'BlockVersion' might be completely new, in this case
    -- we check that proposed modifier can follow the adopted block
    -- version data;
    --
    -- • proposed 'BlockVersion' might be the adopted one,
    -- in this case we check that proposed modifier corresponds to the
    -- adopted block version data;
    --
    -- • proposed 'BlockVersion' might be not adopted but competing,
    -- in this case we check that proposed modifier is the same as the
    -- one associated with the proposed block version.
    getBVDataOrModifier ::
           m $ Maybe $ Either BlockVersionData BlockVersionModifier
    getBVDataOrModifier =
        -- maybe tryAdoptedBVD (pure . pure . pure . bvsModifier) =<<
        maybe tryAdoptedBVD (pure . Just . Right . bvsModifier) =<<
        getBVState proposedBV
    tryAdoptedBVD =
        getAdoptedBVFull <&> \case
            (bv, bvd)
                | bv == proposedBV -> Just (Left bvd)
                | otherwise -> Nothing

-- Check whether all filled fields from 'BlockVersionModifier'
-- correspond to their analogues from 'BlockVersionData'.
bvmMatchesBVD :: BlockVersionModifier -> BlockVersionData -> Bool
-- Note: record wild cards and all other approaches to pattern
-- matching are not used here, because we want to have a warning if we
-- add something to these types and forget to update this function.
bvmMatchesBVD
          ( BlockVersionModifier
    bvmScriptVersion
    bvmSlotDuration
    bvmMaxBlockSize
    bvmMaxHeaderSize
    bvmMaxTxSize
    bvmMaxProposalSize
    bvmMpcThd
    bvmHeavyDelThd
    bvmUpdateVoteThd
    bvmUpdateProposalThd
    bvmUpdateImplicit
    bvmSoftforkRule
    bvmTxFeePolicy
    bvmUnlockStakeEpoch
        ) ( BlockVersionData
    bvdScriptVersion
    bvdSlotDuration
    bvdMaxBlockSize
    bvdMaxHeaderSize
    bvdMaxTxSize
    bvdMaxProposalSize
    bvdMpcThd
    bvdHeavyDelThd
    bvdUpdateVoteThd
    bvdUpdateProposalThd
    bvdUpdateImplicit
    bvdSoftforkRule
    bvdTxFeePolicy
    bvdUnlockStakeEpoch
          ) =
          and [
      maybe True (== bvdScriptVersion)     bvmScriptVersion
    , maybe True (== bvdSlotDuration)      bvmSlotDuration
    , maybe True (== bvdMaxBlockSize)      bvmMaxBlockSize
    , maybe True (== bvdMaxHeaderSize)     bvmMaxHeaderSize
    , maybe True (== bvdMaxTxSize)         bvmMaxTxSize
    , maybe True (== bvdMaxProposalSize)   bvmMaxProposalSize
    , maybe True (== bvdMpcThd)            bvmMpcThd
    , maybe True (== bvdHeavyDelThd)       bvmHeavyDelThd
    , maybe True (== bvdUpdateVoteThd)     bvmUpdateVoteThd
    , maybe True (== bvdUpdateProposalThd) bvmUpdateProposalThd
    , maybe True (== bvdUpdateImplicit)    bvmUpdateImplicit
    , maybe True (== bvdSoftforkRule)      bvmSoftforkRule
    , maybe True (== bvdTxFeePolicy)       bvmTxFeePolicy
    , maybe True (== bvdUnlockStakeEpoch)  bvmUnlockStakeEpoch
    ]

-- | @SVChange@ encodes the validity of a SoftwareVersion update
data SVChange = SVIncrement
              | SVNoChange
              | SVInvalid

-- | Here we verify that the proposed SoftwareVersion and BlockVersion
-- are suitable. Since we now have protocol-only updates, it is possible
-- to increment the BlockVersion without the SoftwareVersion. We disallow
-- Updates which increment neither. We continue to support the previous
-- validation rules, which disallow decrements or increments that are too
-- large.
verifyBlockAndSoftwareVersions
    :: (MonadError PollVerFailure m, MonadPollRead m)
    => UpId -> UpdateProposal -> m ()
verifyBlockAndSoftwareVersions upId up = do
    mAdoptedSV <- getLastConfirmedSV app
    bvc <- canBeProposedBV proposedBV
    svc <- flip verifySoftwareVersionPure proposedSV <$> getLastConfirmedSV app
    --
    -- This case expression covers 3x3=9 cases total.
    case (bvc, svc) of
        -- This covers 3 error cases.
        -- We choose (arbitrarily) to give preference to BlockVersion errors.
        (BVInvalid, _) -> do
            lastAdopted <- getAdoptedBV
            throwError
                $ PollBadBlockVersion upId (upBlockVersion up) lastAdopted
        -- This covers 2 error cases.
        (_, SVInvalid) -> do
            throwError
                $ PollWrongSoftwareVersion mAdoptedSV app
                                           (svNumber proposedSV) upId
        -- This covers 1 error case.
        (BVNoChange, SVNoChange) ->
            throwError
                $ PollUpdateVersionNoChange proposedBV (svNumber proposedSV)
        -- These cover the 3 remaining valid cases.
        (BVNoChange,  SVIncrement) -> pass
        (BVIncrement, SVNoChange)  -> pass
        (BVIncrement, SVIncrement) -> pass

  where
    proposedSV = upSoftwareVersion up
    app = svAppName proposedSV
    proposedBV = upBlockVersion up

-- Here we check that a software version is either equal to, or 1
-- greater than, the last confirmed version of the given application.
verifySoftwareVersionPure
    :: Maybe NumSoftwareVersion
    -> SoftwareVersion
    -> SVChange
verifySoftwareVersionPure mAdoptedSVNum proposedSV =
    case mAdoptedSVNum of
        -- If there is no confirmed versions for given application,
        -- We check that version is 0.
        Nothing | svNumber proposedSV == 0 -> SVIncrement
                | otherwise                -> SVInvalid
        -- Otherwise we check that version is 1 more than stored
        -- version.
        Just n
            | svNumber proposedSV == n + 1 -> SVIncrement
            | svNumber proposedSV == n     -> SVNoChange
            | otherwise                    -> SVInvalid
