{-# 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
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
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
Ord, Int -> TxSizeLinear -> ShowS
[TxSizeLinear] -> ShowS
TxSizeLinear -> String
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: TxSizeLinear -> ()
$crnf :: TxSizeLinear -> ()
NFData, Context -> TxSizeLinear -> IO (Maybe ThunkInfo)
Proxy TxSizeLinear -> String
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) = forall a. Format Builder a -> a
bprint (forall a r. Buildable a => Format r (a -> r)
build 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)
" + " forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a r. Buildable a => Format r (a -> r)
build 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 = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR TxSizeLinear where
  fromCBOR :: forall s. Decoder s TxSizeLinear
fromCBOR = 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
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a b. (Integral a, Num b) => a -> b
fromIntegral (Lovelace -> Word64
unsafeGetLovelace Lovelace
a) :: Nano)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. Fractional a => Rational -> a
fromRational Rational
b :: Nano)

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