{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}

-- | This module defines a generalised notion of a "value" - that is, something
-- with which we may quantify a transaction output.
module Cardano.Ledger.Val
  ( Val (..),
    scale,
    invert,
    sumVal,
    scaledMinDeposit,
  )
where

import Data.Group (Abelian)
import Shelley.Spec.Ledger.Coin (Coin (..))

class
  ( Abelian t,
    Eq t
  ) =>
  Val t
  where
  -- | the value with nothing in it
  zero :: t
  zero = t
forall a. Monoid a => a
mempty

  -- | add two value
  (<+>) :: t -> t -> t
  t
x <+> t
y = t
x t -> t -> t
forall a. Semigroup a => a -> a -> a
<> t
y

  -- | scale a value by an Integral constant
  (<×>) :: Integral i => i -> t -> t

  -- | subtract two values
  (<->) :: t -> t -> t
  t
x <-> t
y = t
x t -> t -> t
forall t. Val t => t -> t -> t
<+> ((-Integer
1 :: Integer) Integer -> t -> t
forall t i. (Val t, Integral i) => i -> t -> t
<×> t
y)

  -- | Is the argument zero?
  isZero :: t -> Bool
  isZero t
t = t
t t -> t -> Bool
forall a. Eq a => a -> a -> Bool
== t
forall a. Monoid a => a
mempty

  -- | Get the ADA present in the value (since ADA is our "blessed" currency)
  coin :: t -> Coin

  -- | Create a value containing only this amount of ADA
  inject :: Coin -> t

  -- | modify the blessed Coin part of t
  modifyCoin :: (Coin -> Coin) -> t -> t

  size :: t -> Integer -- compute size of Val instance

  -- | used to compare values pointwise. Rather than using: (v1 <= v2) use: pointwise (<=) v1 v2
  -- | If a quantity is stored in only one of 'v1' or 'v2', we use 0 for the missing quantity.
  pointwise :: (Integer -> Integer -> Bool) -> t -> t -> Bool

-- =============================================================
-- Synonyms with types fixed at (Val t). Makes calls easier
-- to read, and gives better error messages, when a mistake is made

infixl 6 <+>

infixl 6 <->

infixl 7 <×>

scale :: (Val t, Integral i) => i -> t -> t
scale :: i -> t -> t
scale i
i t
v = i
i i -> t -> t
forall t i. (Val t, Integral i) => i -> t -> t
<×> t
v

sumVal :: (Foldable t, Val v) => t v -> v
sumVal :: t v -> v
sumVal t v
xs = (v -> v -> v) -> v -> t v -> v
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl v -> v -> v
forall t. Val t => t -> t -> t
(<+>) v
forall a. Monoid a => a
mempty t v
xs

invert :: Val t => t -> t
invert :: t -> t
invert t
x = (-Integer
1 :: Integer) Integer -> t -> t
forall t i. (Val t, Integral i) => i -> t -> t
<×> t
x

instance Val Coin where
  i
n <×> :: i -> Coin -> Coin
<×> (Coin Integer
x) = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ (i -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral i
n) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
x
  coin :: Coin -> Coin
coin = Coin -> Coin
forall a. a -> a
id
  inject :: Coin -> Coin
inject = Coin -> Coin
forall a. a -> a
id
  size :: Coin -> Integer
size Coin
_ = Integer
1
  modifyCoin :: (Coin -> Coin) -> Coin -> Coin
modifyCoin Coin -> Coin
f Coin
v = Coin -> Coin
f Coin
v
  pointwise :: (Integer -> Integer -> Bool) -> Coin -> Coin -> Bool
pointwise Integer -> Integer -> Bool
p (Coin Integer
x) (Coin Integer
y) = Integer -> Integer -> Bool
p Integer
x Integer
y

{- The scaledMinDeposit calculation uses the minUTxOValue protocol parameter
(passed to it as Coin mv) as a specification of "the cost of
making a Shelley-sized UTxO entry", calculated here by "utxoEntrySizeWithoutVal + uint",
using the constants in the "where" clause.

In the case when a UTxO entry contains coins only (and the Shelley
UTxO entry format is used - we will extend this to be correct for other
UTxO formats shortly), the deposit should be exactly the minUTxOValue.
This is the "inject (coin v) == v" case.

Otherwise, we calculate the per-byte deposit by multiplying the minimum deposit (which is
for the number of Shelley UTxO-entry bytes) by the size of a Shelley UTxO entry.
This is the "(mv * (utxoEntrySizeWithoutVal + uint))" calculation.

We then calculate the total deposit required for making a UTxO entry with a Val-class
member v by dividing "(mv * (utxoEntrySizeWithoutVal + uint))" by the
estimated total size of the UTxO entry containing v, ie by
"(utxoEntrySizeWithoutVal + size v)".

See the formal specification for details.

-}

-- TODO : This scaling function is right for UTxO, not EUTxO
-- constants are temporary, the UTxO entry size calculation will be moved
scaledMinDeposit :: (Val v) => v -> Coin -> Coin
scaledMinDeposit :: v -> Coin -> Coin
scaledMinDeposit v
v (Coin Integer
mv)
  | Coin -> v
forall t. Val t => Coin -> t
inject (v -> Coin
forall t. Val t => t -> Coin
coin v
v) v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v = Integer -> Coin
Coin Integer
mv -- without non-Coin assets, scaled deposit should be exactly minUTxOValue
  | Bool
otherwise = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ (Integer, Integer) -> Integer
forall a b. (a, b) -> a
fst ((Integer, Integer) -> Integer) -> (Integer, Integer) -> Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
quotRem (Integer
mv Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
utxoEntrySizeWithoutVal Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
uint)) (Integer
utxoEntrySizeWithoutVal Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ v -> Integer
forall t. Val t => t -> Integer
size v
v) -- round down
  where
    -- address hash length is always same as Policy ID length
    addrHashLen :: Integer
    addrHashLen :: Integer
addrHashLen = Integer
28

    smallArray :: Integer
    smallArray :: Integer
smallArray = Integer
1

    hashLen :: Integer
    hashLen :: Integer
hashLen = Integer
32

    uint :: Integer
    uint :: Integer
uint = Integer
5

    hashObj :: Integer
    hashObj :: Integer
hashObj = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
hashLen

    addrHeader :: Integer
    addrHeader :: Integer
addrHeader = Integer
1

    address :: Integer
    address :: Integer
address = Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
addrHeader Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
addrHashLen

    -- input size
    inputSize :: Integer
    inputSize :: Integer
inputSize = Integer
smallArray Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
uint Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
hashObj

    -- size of output not including the Val (compute that part with vsize later)
    outputSizeWithoutVal :: Integer
    outputSizeWithoutVal :: Integer
outputSizeWithoutVal = Integer
smallArray Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
address

    -- size of the UTxO entry (ie the space the scaled minUTxOValue deposit pays)
    utxoEntrySizeWithoutVal :: Integer
    utxoEntrySizeWithoutVal :: Integer
utxoEntrySizeWithoutVal = Integer
inputSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
outputSizeWithoutVal