{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Ouroboros.Consensus.Config.SecurityParam
  ( SecurityParam (..)
  , maxRollbackWeight
  ) where

import Cardano.Binary
import Cardano.Ledger.BaseTypes.NonZero
import Data.Word
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Ouroboros.Consensus.Block.SupportsPeras (PerasWeight (..))
import Quiet

-- | Protocol security parameter
--
-- In longest-chain protocols, we interpret this as the number of rollbacks we
-- support.
--
-- i.e., k == 1: we can roll back at most one block
--       k == 2: we can roll back at most two blocks, etc
--
-- NOTE: This talks about the number of /blocks/ we can roll back, not
-- the number of /slots/.
--
-- In weightiest-chain protocols (such as Ouroboros Peras), we interpret this as
-- the maximum amount of weight we can roll back. Here, the total weight of a
-- chain (fragment) is defined to be its length plus the sum of all weight
-- boosts given to some of its blocks on the chain (fragment).
--
-- i.e. k == 30: we can roll back at most 30 unweighted blocks, or two blocks
-- each having additional weight 14. In the latter case, the chain fragment has
-- total weight @2 + 2 * 14 = 30@.
newtype SecurityParam = SecurityParam {SecurityParam -> NonZero Word64
maxRollbacks :: NonZero Word64}
  deriving (SecurityParam -> SecurityParam -> Bool
(SecurityParam -> SecurityParam -> Bool)
-> (SecurityParam -> SecurityParam -> Bool) -> Eq SecurityParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecurityParam -> SecurityParam -> Bool
== :: SecurityParam -> SecurityParam -> Bool
$c/= :: SecurityParam -> SecurityParam -> Bool
/= :: SecurityParam -> SecurityParam -> Bool
Eq, (forall x. SecurityParam -> Rep SecurityParam x)
-> (forall x. Rep SecurityParam x -> SecurityParam)
-> Generic SecurityParam
forall x. Rep SecurityParam x -> SecurityParam
forall x. SecurityParam -> Rep SecurityParam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecurityParam -> Rep SecurityParam x
from :: forall x. SecurityParam -> Rep SecurityParam x
$cto :: forall x. Rep SecurityParam x -> SecurityParam
to :: forall x. Rep SecurityParam x -> SecurityParam
Generic, Context -> SecurityParam -> IO (Maybe ThunkInfo)
Proxy SecurityParam -> String
(Context -> SecurityParam -> IO (Maybe ThunkInfo))
-> (Context -> SecurityParam -> IO (Maybe ThunkInfo))
-> (Proxy SecurityParam -> String)
-> NoThunks SecurityParam
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SecurityParam -> IO (Maybe ThunkInfo)
noThunks :: Context -> SecurityParam -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SecurityParam -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SecurityParam -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SecurityParam -> String
showTypeOf :: Proxy SecurityParam -> String
NoThunks, Typeable SecurityParam
Typeable SecurityParam =>
(SecurityParam -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy SecurityParam -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [SecurityParam] -> Size)
-> ToCBOR SecurityParam
SecurityParam -> Encoding
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SecurityParam] -> Size
(forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SecurityParam -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: SecurityParam -> Encoding
toCBOR :: SecurityParam -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SecurityParam -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy SecurityParam -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SecurityParam] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy [SecurityParam] -> Size
ToCBOR, Typeable SecurityParam
Typeable SecurityParam =>
(forall s. Decoder s SecurityParam)
-> (Proxy SecurityParam -> Text) -> FromCBOR SecurityParam
Proxy SecurityParam -> Text
forall s. Decoder s SecurityParam
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s SecurityParam
fromCBOR :: forall s. Decoder s SecurityParam
$clabel :: Proxy SecurityParam -> Text
label :: Proxy SecurityParam -> Text
FromCBOR)
  deriving Int -> SecurityParam -> ShowS
[SecurityParam] -> ShowS
SecurityParam -> String
(Int -> SecurityParam -> ShowS)
-> (SecurityParam -> String)
-> ([SecurityParam] -> ShowS)
-> Show SecurityParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecurityParam -> ShowS
showsPrec :: Int -> SecurityParam -> ShowS
$cshow :: SecurityParam -> String
show :: SecurityParam -> String
$cshowList :: [SecurityParam] -> ShowS
showList :: [SecurityParam] -> ShowS
Show via Quiet SecurityParam

-- | The maximum amount of weight we can roll back.
maxRollbackWeight :: SecurityParam -> PerasWeight
maxRollbackWeight :: SecurityParam -> PerasWeight
maxRollbackWeight = Word64 -> PerasWeight
PerasWeight (Word64 -> PerasWeight)
-> (SecurityParam -> Word64) -> SecurityParam -> PerasWeight
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero (NonZero Word64 -> Word64)
-> (SecurityParam -> NonZero Word64) -> SecurityParam -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecurityParam -> NonZero Word64
maxRollbacks