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

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

import Cardano.Binary
  ( Decoder,
    DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    encodeListLen,
    enforceSize,
  )
import Cardano.Chain.Common.Lovelace
  ( Lovelace,
    LovelaceError,
    addLovelace,
    integerToLovelace,
    mkLovelace,
    scaleLovelaceRationalUp,
    unsafeGetLovelace,
  )
import Cardano.Prelude
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
/= :: TxSizeLinear -> TxSizeLinear -> Bool
$c/= :: TxSizeLinear -> TxSizeLinear -> Bool
== :: TxSizeLinear -> TxSizeLinear -> Bool
$c== :: 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
min :: TxSizeLinear -> TxSizeLinear -> TxSizeLinear
$cmin :: TxSizeLinear -> TxSizeLinear -> TxSizeLinear
max :: TxSizeLinear -> TxSizeLinear -> TxSizeLinear
$cmax :: TxSizeLinear -> TxSizeLinear -> TxSizeLinear
>= :: TxSizeLinear -> TxSizeLinear -> Bool
$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
compare :: TxSizeLinear -> TxSizeLinear -> Ordering
$ccompare :: TxSizeLinear -> TxSizeLinear -> Ordering
$cp1Ord :: Eq 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
showList :: [TxSizeLinear] -> ShowS
$cshowList :: [TxSizeLinear] -> ShowS
show :: TxSizeLinear -> String
$cshow :: TxSizeLinear -> String
showsPrec :: Int -> TxSizeLinear -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep TxSizeLinear x -> TxSizeLinear
$cfrom :: forall x. TxSizeLinear -> Rep TxSizeLinear x
Generic)
  deriving anyclass (TxSizeLinear -> ()
(TxSizeLinear -> ()) -> NFData TxSizeLinear
forall a. (a -> ()) -> NFData a
rnf :: TxSizeLinear -> ()
$crnf :: 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
showTypeOf :: Proxy TxSizeLinear -> String
$cshowTypeOf :: Proxy TxSizeLinear -> String
wNoThunks :: Context -> TxSizeLinear -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TxSizeLinear -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxSizeLinear -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> TxSizeLinear -> IO (Maybe ThunkInfo)
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 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 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 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

-- Used for debugging purposes only
instance ToJSON TxSizeLinear

instance ToCBOR TxSizeLinear where
  -- We encode as 'Nano' for backwards compatibility
  toCBOR :: TxSizeLinear -> Encoding
toCBOR (TxSizeLinear Lovelace
a Rational
b) =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Nano -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (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. ToCBOR a => a -> Encoding
toCBOR (Rational -> Nano
forall a. Fractional a => Rational -> a
fromRational Rational
b :: Nano)

instance FromCBOR TxSizeLinear where
  fromCBOR :: Decoder s TxSizeLinear
fromCBOR = 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 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Nano -> Word64
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 s. FromCBOR Nano => Decoder s Nano
forall a s. FromCBOR a => Decoder s a
fromCBOR @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 s. FromCBOR Nano => Decoder s Nano
forall a s. FromCBOR a => Decoder s a
fromCBOR @Nano
    TxSizeLinear -> Decoder s TxSizeLinear
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 :: Either LovelaceError Lovelace -> Decoder s Lovelace
wrapLovelaceError =
        Either DecoderError Lovelace -> Decoder s Lovelace
forall e a s. Buildable e => Either e a -> Decoder s a
toCborError (Either DecoderError Lovelace -> Decoder s Lovelace)
-> (Either LovelaceError Lovelace -> Either DecoderError Lovelace)
-> Either LovelaceError Lovelace
-> Decoder s Lovelace
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 (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 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