{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

module Cardano.Chain.Common.TxSizeLinear (
  TxSizeLinear (..),
  txSizeLinearMinValue,
  calculateTxSizeLinear,
) where

import Cardano.Chain.Common.Lovelace (
  Lovelace,
  LovelaceError,
  addLovelace,
  integerToLovelace,
  mkLovelace,
  scaleLovelaceRationalUp,
  unsafeGetLovelace,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  Decoder,
  DecoderError (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  toByronCBOR,
  toCborError,
 )
import Cardano.Prelude hiding (toCborError)
import Data.Aeson (ToJSON)
import Data.Fixed (Nano)
import Formatting (bprint, build, sformat)
import qualified Formatting.Buildable as B
import NoThunks.Class (NoThunks (..))

-- | A linear equation on the transaction size. Represents the @\s -> a + b*s@
-- function where @s@ is the transaction size in bytes, @a@ and @b@ are
-- constant coefficients.
data TxSizeLinear
  = TxSizeLinear !Lovelace !Rational
  deriving (TxSizeLinear -> TxSizeLinear -> Bool
(TxSizeLinear -> TxSizeLinear -> Bool)
-> (TxSizeLinear -> TxSizeLinear -> Bool) -> Eq TxSizeLinear
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxSizeLinear -> TxSizeLinear -> Bool
== :: TxSizeLinear -> TxSizeLinear -> Bool
$c/= :: TxSizeLinear -> TxSizeLinear -> Bool
/= :: TxSizeLinear -> TxSizeLinear -> Bool
Eq, Eq TxSizeLinear
Eq TxSizeLinear =>
(TxSizeLinear -> TxSizeLinear -> Ordering)
-> (TxSizeLinear -> TxSizeLinear -> Bool)
-> (TxSizeLinear -> TxSizeLinear -> Bool)
-> (TxSizeLinear -> TxSizeLinear -> Bool)
-> (TxSizeLinear -> TxSizeLinear -> Bool)
-> (TxSizeLinear -> TxSizeLinear -> TxSizeLinear)
-> (TxSizeLinear -> TxSizeLinear -> TxSizeLinear)
-> Ord TxSizeLinear
TxSizeLinear -> TxSizeLinear -> Bool
TxSizeLinear -> TxSizeLinear -> Ordering
TxSizeLinear -> TxSizeLinear -> TxSizeLinear
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
$ccompare :: TxSizeLinear -> TxSizeLinear -> Ordering
compare :: TxSizeLinear -> TxSizeLinear -> Ordering
$c< :: TxSizeLinear -> TxSizeLinear -> Bool
< :: TxSizeLinear -> TxSizeLinear -> Bool
$c<= :: TxSizeLinear -> TxSizeLinear -> Bool
<= :: TxSizeLinear -> TxSizeLinear -> Bool
$c> :: TxSizeLinear -> TxSizeLinear -> Bool
> :: TxSizeLinear -> TxSizeLinear -> Bool
$c>= :: TxSizeLinear -> TxSizeLinear -> Bool
>= :: TxSizeLinear -> TxSizeLinear -> Bool
$cmax :: TxSizeLinear -> TxSizeLinear -> TxSizeLinear
max :: TxSizeLinear -> TxSizeLinear -> TxSizeLinear
$cmin :: TxSizeLinear -> TxSizeLinear -> TxSizeLinear
min :: TxSizeLinear -> TxSizeLinear -> TxSizeLinear
Ord, Int -> TxSizeLinear -> ShowS
[TxSizeLinear] -> ShowS
TxSizeLinear -> String
(Int -> TxSizeLinear -> ShowS)
-> (TxSizeLinear -> String)
-> ([TxSizeLinear] -> ShowS)
-> Show TxSizeLinear
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxSizeLinear -> ShowS
showsPrec :: Int -> TxSizeLinear -> ShowS
$cshow :: TxSizeLinear -> String
show :: TxSizeLinear -> String
$cshowList :: [TxSizeLinear] -> ShowS
showList :: [TxSizeLinear] -> ShowS
Show, (forall x. TxSizeLinear -> Rep TxSizeLinear x)
-> (forall x. Rep TxSizeLinear x -> TxSizeLinear)
-> Generic TxSizeLinear
forall x. Rep TxSizeLinear x -> TxSizeLinear
forall x. TxSizeLinear -> Rep TxSizeLinear x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxSizeLinear -> Rep TxSizeLinear x
from :: forall x. TxSizeLinear -> Rep TxSizeLinear x
$cto :: forall x. Rep TxSizeLinear x -> TxSizeLinear
to :: forall x. Rep TxSizeLinear x -> TxSizeLinear
Generic)
  deriving anyclass (TxSizeLinear -> ()
(TxSizeLinear -> ()) -> NFData TxSizeLinear
forall a. (a -> ()) -> NFData a
$crnf :: TxSizeLinear -> ()
rnf :: TxSizeLinear -> ()
NFData, Context -> TxSizeLinear -> IO (Maybe ThunkInfo)
Proxy TxSizeLinear -> String
(Context -> TxSizeLinear -> IO (Maybe ThunkInfo))
-> (Context -> TxSizeLinear -> IO (Maybe ThunkInfo))
-> (Proxy TxSizeLinear -> String)
-> NoThunks TxSizeLinear
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> TxSizeLinear -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxSizeLinear -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxSizeLinear -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> TxSizeLinear -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy TxSizeLinear -> String
showTypeOf :: Proxy TxSizeLinear -> String
NoThunks)

instance B.Buildable TxSizeLinear where
  build :: TxSizeLinear -> Builder
build (TxSizeLinear Lovelace
a Rational
b) = Format Builder (Lovelace -> Rational -> Builder)
-> Lovelace -> Rational -> Builder
forall a. Format Builder a -> a
bprint (Format (Rational -> Builder) (Lovelace -> Rational -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format (Rational -> Builder) (Lovelace -> Rational -> Builder)
-> Format Builder (Rational -> Builder)
-> Format Builder (Lovelace -> Rational -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format (Rational -> Builder) (Rational -> Builder)
" + " Format (Rational -> Builder) (Rational -> Builder)
-> Format Builder (Rational -> Builder)
-> Format Builder (Rational -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Rational -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (Rational -> Builder)
-> Format Builder Builder -> Format Builder (Rational -> Builder)
forall b c a. Format b c -> Format a b -> Format a c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder Builder
"*s") Lovelace
a Rational
b

instance ToCBOR TxSizeLinear where
  toCBOR :: TxSizeLinear -> Encoding
toCBOR = TxSizeLinear -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR TxSizeLinear where
  fromCBOR :: forall s. Decoder s TxSizeLinear
fromCBOR = Decoder s TxSizeLinear
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- Used for debugging purposes only
instance ToJSON TxSizeLinear

instance EncCBOR TxSizeLinear where
  -- We encode as 'Nano' for backwards compatibility
  encCBOR :: TxSizeLinear -> Encoding
encCBOR (TxSizeLinear Lovelace
a Rational
b) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Nano -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word64 -> Nano
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Lovelace -> Word64
unsafeGetLovelace Lovelace
a) :: Nano)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Nano -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Rational -> Nano
forall a. Fractional a => Rational -> a
fromRational Rational
b :: Nano)

instance DecCBOR TxSizeLinear where
  decCBOR :: forall s. Decoder s TxSizeLinear
decCBOR = do
    Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"TxSizeLinear" Int
2
    !Lovelace
a <- Either LovelaceError Lovelace -> Decoder s Lovelace
forall s. Either LovelaceError Lovelace -> Decoder s Lovelace
wrapLovelaceError (Either LovelaceError Lovelace -> Decoder s Lovelace)
-> (Nano -> Either LovelaceError Lovelace)
-> Nano
-> Decoder s Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Word64 -> Either LovelaceError Lovelace
mkLovelace (Word64 -> Either LovelaceError Lovelace)
-> (Nano -> Word64) -> Nano -> Either LovelaceError Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Nano -> Word64
forall b. Integral b => Nano -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Nano -> Decoder s Lovelace)
-> Decoder s Nano -> Decoder s Lovelace
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a s. DecCBOR a => Decoder s a
decCBOR @Nano
    !Rational
b <- Nano -> Rational
forall a. Real a => a -> Rational
toRational (Nano -> Rational) -> Decoder s Nano -> Decoder s Rational
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR @Nano
    TxSizeLinear -> Decoder s TxSizeLinear
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (TxSizeLinear -> Decoder s TxSizeLinear)
-> TxSizeLinear -> Decoder s TxSizeLinear
forall a b. (a -> b) -> a -> b
$ Lovelace -> Rational -> TxSizeLinear
TxSizeLinear Lovelace
a Rational
b
    where
      wrapLovelaceError :: Either LovelaceError Lovelace -> Decoder s Lovelace
      wrapLovelaceError :: forall s. Either LovelaceError Lovelace -> Decoder s Lovelace
wrapLovelaceError =
        Either DecoderError Lovelace -> Decoder s Lovelace
forall (m :: * -> *) e a.
(MonadFail m, Buildable e) =>
Either e a -> m a
toCborError (Either DecoderError Lovelace -> Decoder s Lovelace)
-> (Either LovelaceError Lovelace -> Either DecoderError Lovelace)
-> Either LovelaceError Lovelace
-> Decoder s Lovelace
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (LovelaceError -> DecoderError)
-> Either LovelaceError Lovelace -> Either DecoderError Lovelace
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Text -> DecoderError
DecoderErrorCustom Text
"TxSizeLinear" (Text -> DecoderError)
-> (LovelaceError -> Text) -> LovelaceError -> DecoderError
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Text (LovelaceError -> Text) -> LovelaceError -> Text
forall a. Format Text a -> a
sformat Format Text (LovelaceError -> Text)
forall a r. Buildable a => Format r (a -> r)
build)

calculateTxSizeLinear ::
  TxSizeLinear -> Natural -> Either LovelaceError Lovelace
calculateTxSizeLinear :: TxSizeLinear -> Natural -> Either LovelaceError Lovelace
calculateTxSizeLinear (TxSizeLinear Lovelace
a Rational
b) Natural
sz =
  Lovelace -> Lovelace -> Either LovelaceError Lovelace
addLovelace Lovelace
a
    (Lovelace -> Either LovelaceError Lovelace)
-> Either LovelaceError Lovelace -> Either LovelaceError Lovelace
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Lovelace -> Rational -> Lovelace)
-> Rational -> Lovelace -> Lovelace
forall a b c. (a -> b -> c) -> b -> a -> c
flip Lovelace -> Rational -> Lovelace
scaleLovelaceRationalUp Rational
b
    (Lovelace -> Lovelace)
-> Either LovelaceError Lovelace -> Either LovelaceError Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Integer -> Either LovelaceError Lovelace
integerToLovelace (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
sz)

txSizeLinearMinValue :: TxSizeLinear -> Lovelace
txSizeLinearMinValue :: TxSizeLinear -> Lovelace
txSizeLinearMinValue (TxSizeLinear Lovelace
a Rational
_) = Lovelace
a