-- | Constants derived from security parameter
--
--   TODO: Find a better home for these
module Cardano.Chain.ProtocolConstants
  ( kSlotSecurityParam,
    kUpdateStabilityParam,
    kChainQualityThreshold,
    kEpochSlots,
  )
where

import Cardano.Chain.Common.BlockCount (BlockCount (..))
import Cardano.Chain.Slotting.EpochSlots (EpochSlots (..))
import Cardano.Chain.Slotting.SlotCount (SlotCount (..))
import Cardano.Prelude

-- | Security parameter expressed in number of slots. It uses chain quality
--   property. It's basically @blkSecurityParam / chainQualityThreshold@.
kSlotSecurityParam :: BlockCount -> SlotCount
kSlotSecurityParam :: BlockCount -> SlotCount
kSlotSecurityParam = Word64 -> SlotCount
SlotCount (Word64 -> SlotCount)
-> (BlockCount -> Word64) -> BlockCount -> SlotCount
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(*) Word64
2 (Word64 -> Word64)
-> (BlockCount -> Word64) -> BlockCount -> Word64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockCount -> Word64
unBlockCount

-- | Update stability parameter expressed in number of slots. This is the time
--   between an protocol version update receiving its final endorsement and
--   being accepted, and is set to double the security param.
--
--   This extra safety margin is required because an update in the protocol
--   version may trigger a hard fork, which can change "era"-level parameters
--   such as slot length and the number of slots per epoch. As such, the
--   consensus layer wishes to always have a margin between such an update being
--   _certain to happen_ and it actually happening.
--
--   For full details, you can see
--   https://github.com/input-output-hk/cardano-ledger/issues/1288
kUpdateStabilityParam :: BlockCount -> SlotCount
kUpdateStabilityParam :: BlockCount -> SlotCount
kUpdateStabilityParam = Word64 -> SlotCount
SlotCount (Word64 -> SlotCount)
-> (BlockCount -> Word64) -> BlockCount -> SlotCount
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(*) Word64
4 (Word64 -> Word64)
-> (BlockCount -> Word64) -> BlockCount -> Word64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockCount -> Word64
unBlockCount

-- | Minimal chain quality (number of blocks divided by number of
--   slots) necessary for security of the system.
kChainQualityThreshold :: Fractional f => BlockCount -> f
kChainQualityThreshold :: BlockCount -> f
kChainQualityThreshold BlockCount
k =
  Word64 -> f
forall a b. (Real a, Fractional b) => a -> b
realToFrac (BlockCount -> Word64
unBlockCount BlockCount
k)
    f -> f -> f
forall a. Fractional a => a -> a -> a
/ Word64 -> f
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SlotCount -> Word64
unSlotCount (SlotCount -> Word64) -> SlotCount -> Word64
forall a b. (a -> b) -> a -> b
$ BlockCount -> SlotCount
kSlotSecurityParam BlockCount
k)

-- | Number of slots inside one epoch
kEpochSlots :: BlockCount -> EpochSlots
kEpochSlots :: BlockCount -> EpochSlots
kEpochSlots = Word64 -> EpochSlots
EpochSlots (Word64 -> EpochSlots)
-> (BlockCount -> Word64) -> BlockCount -> EpochSlots
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
(*) Word64
10 (Word64 -> Word64)
-> (BlockCount -> Word64) -> BlockCount -> Word64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. BlockCount -> Word64
unBlockCount