{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
module Cardano.Ledger.Val
( Val (..),
scale,
invert,
sumVal,
scaledMinDeposit,
DecodeNonNegative (..),
DecodeMint (..),
EncodeMint (..),
)
where
import Cardano.Binary (Decoder, Encoding, decodeWord64, toCBOR)
import Cardano.Ledger.Compactible (Compactible (..))
import Data.Group (Abelian)
import Shelley.Spec.Ledger.Coin (Coin (..), DeltaCoin (..))
class
( Abelian t,
Eq t
) =>
Val t
where
zero :: t
zero = t
forall a. Monoid a => a
mempty
(<+>) :: t -> t -> t
t
x <+> t
y = t
x t -> t -> t
forall a. Semigroup a => a -> a -> a
<> t
y
(<×>) :: Integral i => i -> t -> t
(<->) :: 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)
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
coin :: t -> Coin
inject :: Coin -> t
modifyCoin :: (Coin -> Coin) -> t -> t
size :: t -> Integer
pointwise :: (Integer -> Integer -> Bool) -> t -> t -> Bool
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
deriving via Coin instance Val DeltaCoin
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
| Bool
otherwise = Integer -> Coin
Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Integer
adaPerUTxOByte Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Integer
utxoEntrySizeWithoutVal Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ v -> Integer
forall t. Val t => t -> Integer
size v
v)
where
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
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
outputSizeWithoutVal :: Integer
outputSizeWithoutVal :: Integer
outputSizeWithoutVal = Integer
smallArray Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
address
utxoEntrySizeWithoutVal :: Integer
utxoEntrySizeWithoutVal :: Integer
utxoEntrySizeWithoutVal = Integer
inputSize Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
outputSizeWithoutVal
adaPerUTxOByte :: Integer
adaPerUTxOByte :: Integer
adaPerUTxOByte = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
quot Integer
mv (Integer
utxoEntrySizeWithoutVal Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
uint)
class DecodeNonNegative v where
decodeNonNegative :: Decoder s v
instance DecodeNonNegative Coin where
decodeNonNegative :: Decoder s Coin
decodeNonNegative = Integer -> Coin
Coin (Integer -> Coin) -> (Word64 -> Integer) -> Word64 -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Coin) -> Decoder s Word64 -> Decoder s Coin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
decodeWord64
instance (DecodeNonNegative a, Compactible a, Show a) => DecodeNonNegative (CompactForm a) where
decodeNonNegative :: Decoder s (CompactForm a)
decodeNonNegative = do
a
v <- Decoder s a
forall v s. DecodeNonNegative v => Decoder s v
decodeNonNegative
Decoder s (CompactForm a)
-> (CompactForm a -> Decoder s (CompactForm a))
-> Maybe (CompactForm a)
-> Decoder s (CompactForm a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Decoder s (CompactForm a)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (CompactForm a))
-> String -> Decoder s (CompactForm a)
forall a b. (a -> b) -> a -> b
$ String
"illegal value: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
v) CompactForm a -> Decoder s (CompactForm a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe (CompactForm a)
forall a. Compactible a => a -> Maybe (CompactForm a)
toCompact a
v)
class DecodeMint v where
decodeMint :: Decoder s v
instance DecodeMint Coin where
decodeMint :: Decoder s Coin
decodeMint = String -> Decoder s Coin
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cannot have coin in mint field"
class EncodeMint v where
encodeMint :: v -> Encoding
instance EncodeMint Coin where
encodeMint :: Coin -> Encoding
encodeMint = Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR