{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# 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,
    adaOnly,
    DecodeNonNegative (..),
    DecodeMint (..),
    EncodeMint (..),
  )
where

import Cardano.Binary (Decoder, Encoding, decodeWord64, toCBOR)
import Cardano.Ledger.Coin (Coin (..), CompactForm (..), DeltaCoin (..))
import Cardano.Ledger.Compactible (Compactible (..))
import Data.Coerce
import Data.Foldable (foldl')
import Data.Group (Abelian)

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

  -- | Check if value contains only ADA. Must hold property:
  --
  -- > inject (coin v) == v
  isAdaOnly :: t -> Bool

  isAdaOnlyCompact :: CompactForm t -> Bool

  injectCompact :: CompactForm Coin -> CompactForm t

-- =============================================================
-- 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 = (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

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

-- returns a Value containing only the coin (ada) tokens from the input Value
adaOnly :: Val v => v -> Bool
adaOnly :: v -> Bool
adaOnly v
v = (Coin -> v
forall t. Val t => Coin -> t
inject (Coin -> v) -> (v -> Coin) -> v -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Coin
forall t. Val t => t -> Coin
coin) v
v v -> v -> Bool
forall a. Eq a => a -> a -> Bool
== v
v
{-# DEPRECATED adaOnly "In favor of `isAdaOnly`" #-}

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
  isAdaOnly :: Coin -> Bool
isAdaOnly Coin
_ = Bool
True
  isAdaOnlyCompact :: CompactForm Coin -> Bool
isAdaOnlyCompact CompactForm Coin
_ = Bool
True
  injectCompact :: CompactForm Coin -> CompactForm Coin
injectCompact = CompactForm Coin -> CompactForm Coin
forall a. a -> a
id

instance Val DeltaCoin where
  i
n <×> :: i -> DeltaCoin -> DeltaCoin
<×> (DeltaCoin Integer
x) = Integer -> DeltaCoin
DeltaCoin (Integer -> DeltaCoin) -> Integer -> DeltaCoin
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 :: DeltaCoin -> Coin
coin = DeltaCoin -> Coin
coerce
  inject :: Coin -> DeltaCoin
inject = Coin -> DeltaCoin
coerce
  size :: DeltaCoin -> Integer
size DeltaCoin
_ = Integer
1
  modifyCoin :: (Coin -> Coin) -> DeltaCoin -> DeltaCoin
modifyCoin Coin -> Coin
f DeltaCoin
v = (Coin -> Coin) -> DeltaCoin -> DeltaCoin
coerce Coin -> Coin
f DeltaCoin
v
  pointwise :: (Integer -> Integer -> Bool) -> DeltaCoin -> DeltaCoin -> Bool
pointwise Integer -> Integer -> Bool
p (DeltaCoin Integer
x) (DeltaCoin Integer
y) = Integer -> Integer -> Bool
p Integer
x Integer
y
  isAdaOnly :: DeltaCoin -> Bool
isAdaOnly DeltaCoin
_ = Bool
True
  isAdaOnlyCompact :: CompactForm DeltaCoin -> Bool
isAdaOnlyCompact CompactForm DeltaCoin
_ = Bool
True
  injectCompact :: CompactForm Coin -> CompactForm DeltaCoin
injectCompact (CompactCoin cc) = Word64 -> CompactForm DeltaCoin
CompactDeltaCoin Word64
cc

-- =============================================================

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
  -- we expect nothing to be able to successfully decode this
  -- this is an alternative to throwing an error at encoding
  encodeMint :: Coin -> Encoding
encodeMint = Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR