{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

module Cardano.Chain.Common.ChainDifficulty
  ( ChainDifficulty (..),
    dropChainDifficulty,
  )
where

import Cardano.Binary
  ( Dropper,
    FromCBOR (..),
    ToCBOR (..),
    dropWord64,
    encodeListLen,
    enforceSize,
  )
import Cardano.Prelude
import Data.Aeson (ToJSON)
import Formatting.Buildable (Buildable)
import NoThunks.Class (NoThunks (..))

-- | Chain difficulty represents necessary effort to generate a
-- chain. In the simplest case it can be number of blocks in chain.
newtype ChainDifficulty = ChainDifficulty
  { ChainDifficulty -> Word64
unChainDifficulty :: Word64
  }
  deriving (Int -> ChainDifficulty -> ShowS
[ChainDifficulty] -> ShowS
ChainDifficulty -> String
(Int -> ChainDifficulty -> ShowS)
-> (ChainDifficulty -> String)
-> ([ChainDifficulty] -> ShowS)
-> Show ChainDifficulty
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainDifficulty] -> ShowS
$cshowList :: [ChainDifficulty] -> ShowS
show :: ChainDifficulty -> String
$cshow :: ChainDifficulty -> String
showsPrec :: Int -> ChainDifficulty -> ShowS
$cshowsPrec :: Int -> ChainDifficulty -> ShowS
Show, ChainDifficulty -> ChainDifficulty -> Bool
(ChainDifficulty -> ChainDifficulty -> Bool)
-> (ChainDifficulty -> ChainDifficulty -> Bool)
-> Eq ChainDifficulty
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainDifficulty -> ChainDifficulty -> Bool
$c/= :: ChainDifficulty -> ChainDifficulty -> Bool
== :: ChainDifficulty -> ChainDifficulty -> Bool
$c== :: ChainDifficulty -> ChainDifficulty -> Bool
Eq, Eq ChainDifficulty
Eq ChainDifficulty
-> (ChainDifficulty -> ChainDifficulty -> Ordering)
-> (ChainDifficulty -> ChainDifficulty -> Bool)
-> (ChainDifficulty -> ChainDifficulty -> Bool)
-> (ChainDifficulty -> ChainDifficulty -> Bool)
-> (ChainDifficulty -> ChainDifficulty -> Bool)
-> (ChainDifficulty -> ChainDifficulty -> ChainDifficulty)
-> (ChainDifficulty -> ChainDifficulty -> ChainDifficulty)
-> Ord ChainDifficulty
ChainDifficulty -> ChainDifficulty -> Bool
ChainDifficulty -> ChainDifficulty -> Ordering
ChainDifficulty -> ChainDifficulty -> ChainDifficulty
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ChainDifficulty -> ChainDifficulty -> ChainDifficulty
$cmin :: ChainDifficulty -> ChainDifficulty -> ChainDifficulty
max :: ChainDifficulty -> ChainDifficulty -> ChainDifficulty
$cmax :: ChainDifficulty -> ChainDifficulty -> ChainDifficulty
>= :: ChainDifficulty -> ChainDifficulty -> Bool
$c>= :: ChainDifficulty -> ChainDifficulty -> Bool
> :: ChainDifficulty -> ChainDifficulty -> Bool
$c> :: ChainDifficulty -> ChainDifficulty -> Bool
<= :: ChainDifficulty -> ChainDifficulty -> Bool
$c<= :: ChainDifficulty -> ChainDifficulty -> Bool
< :: ChainDifficulty -> ChainDifficulty -> Bool
$c< :: ChainDifficulty -> ChainDifficulty -> Bool
compare :: ChainDifficulty -> ChainDifficulty -> Ordering
$ccompare :: ChainDifficulty -> ChainDifficulty -> Ordering
$cp1Ord :: Eq ChainDifficulty
Ord, Int -> ChainDifficulty
ChainDifficulty -> Int
ChainDifficulty -> [ChainDifficulty]
ChainDifficulty -> ChainDifficulty
ChainDifficulty -> ChainDifficulty -> [ChainDifficulty]
ChainDifficulty
-> ChainDifficulty -> ChainDifficulty -> [ChainDifficulty]
(ChainDifficulty -> ChainDifficulty)
-> (ChainDifficulty -> ChainDifficulty)
-> (Int -> ChainDifficulty)
-> (ChainDifficulty -> Int)
-> (ChainDifficulty -> [ChainDifficulty])
-> (ChainDifficulty -> ChainDifficulty -> [ChainDifficulty])
-> (ChainDifficulty -> ChainDifficulty -> [ChainDifficulty])
-> (ChainDifficulty
    -> ChainDifficulty -> ChainDifficulty -> [ChainDifficulty])
-> Enum ChainDifficulty
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ChainDifficulty
-> ChainDifficulty -> ChainDifficulty -> [ChainDifficulty]
$cenumFromThenTo :: ChainDifficulty
-> ChainDifficulty -> ChainDifficulty -> [ChainDifficulty]
enumFromTo :: ChainDifficulty -> ChainDifficulty -> [ChainDifficulty]
$cenumFromTo :: ChainDifficulty -> ChainDifficulty -> [ChainDifficulty]
enumFromThen :: ChainDifficulty -> ChainDifficulty -> [ChainDifficulty]
$cenumFromThen :: ChainDifficulty -> ChainDifficulty -> [ChainDifficulty]
enumFrom :: ChainDifficulty -> [ChainDifficulty]
$cenumFrom :: ChainDifficulty -> [ChainDifficulty]
fromEnum :: ChainDifficulty -> Int
$cfromEnum :: ChainDifficulty -> Int
toEnum :: Int -> ChainDifficulty
$ctoEnum :: Int -> ChainDifficulty
pred :: ChainDifficulty -> ChainDifficulty
$cpred :: ChainDifficulty -> ChainDifficulty
succ :: ChainDifficulty -> ChainDifficulty
$csucc :: ChainDifficulty -> ChainDifficulty
Enum, (forall x. ChainDifficulty -> Rep ChainDifficulty x)
-> (forall x. Rep ChainDifficulty x -> ChainDifficulty)
-> Generic ChainDifficulty
forall x. Rep ChainDifficulty x -> ChainDifficulty
forall x. ChainDifficulty -> Rep ChainDifficulty x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainDifficulty x -> ChainDifficulty
$cfrom :: forall x. ChainDifficulty -> Rep ChainDifficulty x
Generic, ChainDifficulty -> Builder
(ChainDifficulty -> Builder) -> Buildable ChainDifficulty
forall p. (p -> Builder) -> Buildable p
build :: ChainDifficulty -> Builder
$cbuild :: ChainDifficulty -> Builder
Buildable, ChainDifficulty -> ()
(ChainDifficulty -> ()) -> NFData ChainDifficulty
forall a. (a -> ()) -> NFData a
rnf :: ChainDifficulty -> ()
$crnf :: ChainDifficulty -> ()
NFData, Context -> ChainDifficulty -> IO (Maybe ThunkInfo)
Proxy ChainDifficulty -> String
(Context -> ChainDifficulty -> IO (Maybe ThunkInfo))
-> (Context -> ChainDifficulty -> IO (Maybe ThunkInfo))
-> (Proxy ChainDifficulty -> String)
-> NoThunks ChainDifficulty
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ChainDifficulty -> String
$cshowTypeOf :: Proxy ChainDifficulty -> String
wNoThunks :: Context -> ChainDifficulty -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ChainDifficulty -> IO (Maybe ThunkInfo)
noThunks :: Context -> ChainDifficulty -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ChainDifficulty -> IO (Maybe ThunkInfo)
NoThunks)

-- Used for debugging purposes only
instance ToJSON ChainDifficulty

instance ToCBOR ChainDifficulty where
  toCBOR :: ChainDifficulty -> Encoding
toCBOR ChainDifficulty
cd = Word -> Encoding
encodeListLen Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (ChainDifficulty -> Word64
unChainDifficulty ChainDifficulty
cd)

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy ChainDifficulty -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
f Proxy ChainDifficulty
cd = Size
1 Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word64 -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
f (ChainDifficulty -> Word64
unChainDifficulty (ChainDifficulty -> Word64)
-> Proxy ChainDifficulty -> Proxy Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy ChainDifficulty
cd)

instance FromCBOR ChainDifficulty where
  fromCBOR :: Decoder s ChainDifficulty
fromCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ChainDifficulty" Int
1
    Word64 -> ChainDifficulty
ChainDifficulty (Word64 -> ChainDifficulty)
-> Decoder s Word64 -> Decoder s ChainDifficulty
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR

dropChainDifficulty :: Dropper s
dropChainDifficulty :: Dropper s
dropChainDifficulty = do
  Text -> Int -> Dropper s
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"ChainDifficulty" Int
1
  Dropper s
forall s. Dropper s
dropWord64