{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
-- This is for 'mkKnownLovelace''s @n <= 45000000000000000@ constraint, which is
-- considered redundant. TODO: investigate this.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Cardano.Chain.Common.Lovelace (
  -- * Lovelace
  Lovelace,
  LovelaceError (..),
  maxLovelaceVal,

  -- * Constructors
  mkLovelace,
  mkKnownLovelace,

  -- * Formatting
  lovelaceF,

  -- * Conversions
  unsafeGetLovelace,
  lovelaceToInteger,
  integerToLovelace,

  -- * Arithmetic operations
  sumLovelace,
  addLovelace,
  subLovelace,
  scaleLovelace,
  scaleLovelaceRational,
  scaleLovelaceRationalUp,
  divLovelace,
  modLovelace,
)
where

import Cardano.Ledger.Binary (
  DecCBOR (..),
  DecoderError (..),
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  cborError,
  decodeListLen,
  decodeWord8,
  encodeListLen,
  fromByronCBOR,
  matchSize,
  toByronCBOR,
  toCborError,
 )
import Cardano.Prelude hiding (cborError, toCborError)
import Data.Aeson (ToJSON)
import Data.Data (Data)
import Formatting (Format, bprint, build, int, sformat)
import qualified Formatting.Buildable as B
import GHC.TypeLits (type (<=))
import NoThunks.Class (NoThunks (..))
import Quiet
import qualified Text.JSON.Canonical as Canonical (
  FromJSON (..),
  ReportSchemaErrors,
  ToJSON (..),
 )

-- | Lovelace is the least possible unit of currency
newtype Lovelace = Lovelace
  { Lovelace -> Word64
unLovelace :: Word64
  }
  deriving (Eq Lovelace
Lovelace -> Lovelace -> Bool
Lovelace -> Lovelace -> Ordering
Lovelace -> Lovelace -> Lovelace
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 :: Lovelace -> Lovelace -> Lovelace
$cmin :: Lovelace -> Lovelace -> Lovelace
max :: Lovelace -> Lovelace -> Lovelace
$cmax :: Lovelace -> Lovelace -> Lovelace
>= :: Lovelace -> Lovelace -> Bool
$c>= :: Lovelace -> Lovelace -> Bool
> :: Lovelace -> Lovelace -> Bool
$c> :: Lovelace -> Lovelace -> Bool
<= :: Lovelace -> Lovelace -> Bool
$c<= :: Lovelace -> Lovelace -> Bool
< :: Lovelace -> Lovelace -> Bool
$c< :: Lovelace -> Lovelace -> Bool
compare :: Lovelace -> Lovelace -> Ordering
$ccompare :: Lovelace -> Lovelace -> Ordering
Ord, Lovelace -> Lovelace -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Lovelace -> Lovelace -> Bool
$c/= :: Lovelace -> Lovelace -> Bool
== :: Lovelace -> Lovelace -> Bool
$c== :: Lovelace -> Lovelace -> Bool
Eq, forall x. Rep Lovelace x -> Lovelace
forall x. Lovelace -> Rep Lovelace x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Lovelace x -> Lovelace
$cfrom :: forall x. Lovelace -> Rep Lovelace x
Generic, Typeable Lovelace
Lovelace -> DataType
Lovelace -> Constr
(forall b. Data b => b -> b) -> Lovelace -> Lovelace
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Lovelace -> u
forall u. (forall d. Data d => d -> u) -> Lovelace -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Lovelace -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Lovelace -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Lovelace -> m Lovelace
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lovelace -> m Lovelace
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Lovelace
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lovelace -> c Lovelace
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Lovelace)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lovelace)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lovelace -> m Lovelace
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lovelace -> m Lovelace
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lovelace -> m Lovelace
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Lovelace -> m Lovelace
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Lovelace -> m Lovelace
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Lovelace -> m Lovelace
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Lovelace -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Lovelace -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Lovelace -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Lovelace -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Lovelace -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Lovelace -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Lovelace -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Lovelace -> r
gmapT :: (forall b. Data b => b -> b) -> Lovelace -> Lovelace
$cgmapT :: (forall b. Data b => b -> b) -> Lovelace -> Lovelace
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lovelace)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Lovelace)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Lovelace)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Lovelace)
dataTypeOf :: Lovelace -> DataType
$cdataTypeOf :: Lovelace -> DataType
toConstr :: Lovelace -> Constr
$ctoConstr :: Lovelace -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Lovelace
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Lovelace
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lovelace -> c Lovelace
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lovelace -> c Lovelace
Data, Lovelace -> ()
forall a. (a -> ()) -> NFData a
rnf :: Lovelace -> ()
$crnf :: Lovelace -> ()
NFData, Context -> Lovelace -> IO (Maybe ThunkInfo)
Proxy Lovelace -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy Lovelace -> String
$cshowTypeOf :: Proxy Lovelace -> String
wNoThunks :: Context -> Lovelace -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Lovelace -> IO (Maybe ThunkInfo)
noThunks :: Context -> Lovelace -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Lovelace -> IO (Maybe ThunkInfo)
NoThunks)
  deriving (Int -> Lovelace -> ShowS
[Lovelace] -> ShowS
Lovelace -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lovelace] -> ShowS
$cshowList :: [Lovelace] -> ShowS
show :: Lovelace -> String
$cshow :: Lovelace -> String
showsPrec :: Int -> Lovelace -> ShowS
$cshowsPrec :: Int -> Lovelace -> ShowS
Show) via (Quiet Lovelace)

instance B.Buildable Lovelace where
  build :: Lovelace -> Builder
build (Lovelace Word64
n) = forall a. Format Builder a -> a
bprint (forall a r. Integral a => Format r (a -> r)
int 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
" lovelace") Word64
n

instance Bounded Lovelace where
  minBound :: Lovelace
minBound = Word64 -> Lovelace
Lovelace Word64
0
  maxBound :: Lovelace
maxBound = Word64 -> Lovelace
Lovelace Word64
maxLovelaceVal

-- Used for debugging purposes only
instance ToJSON Lovelace

instance ToCBOR Lovelace where
  toCBOR :: Lovelace -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR Lovelace where
  fromCBOR :: forall s. Decoder s Lovelace
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR Lovelace where
  encCBOR :: Lovelace -> Encoding
encCBOR = forall a. EncCBOR a => a -> Encoding
encCBOR forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lovelace -> Word64
unsafeGetLovelace
  encodedSizeExpr :: (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Lovelace -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy Lovelace
pxy = forall t. EncCBOR t => Proxy t -> Size
size (Lovelace -> Word64
unsafeGetLovelace forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Lovelace
pxy)

instance DecCBOR Lovelace where
  decCBOR :: forall s. Decoder s Lovelace
decCBOR = do
    Word64
l <- forall a s. DecCBOR a => Decoder s a
decCBOR
    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
"Lovelace" 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)
      forall a b. (a -> b) -> a -> b
$ Word64 -> Either LovelaceError Lovelace
mkLovelace Word64
l

instance Monad m => Canonical.ToJSON m Lovelace where
  toJSON :: Lovelace -> m JSValue
toJSON = forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
Canonical.toJSON forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lovelace -> Word64
unsafeGetLovelace

instance Canonical.ReportSchemaErrors m => Canonical.FromJSON m Lovelace where
  fromJSON :: JSValue -> m Lovelace
fromJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Lovelace
Lovelace forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (m :: * -> *) a. FromJSON m a => JSValue -> m a
Canonical.fromJSON

data LovelaceError
  = LovelaceOverflow Word64
  | LovelaceTooLarge Integer
  | LovelaceTooSmall Integer
  | LovelaceUnderflow Word64 Word64
  deriving (Typeable LovelaceError
LovelaceError -> DataType
LovelaceError -> Constr
(forall b. Data b => b -> b) -> LovelaceError -> LovelaceError
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> LovelaceError -> u
forall u. (forall d. Data d => d -> u) -> LovelaceError -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LovelaceError -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LovelaceError -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LovelaceError -> m LovelaceError
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LovelaceError -> m LovelaceError
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LovelaceError
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LovelaceError -> c LovelaceError
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LovelaceError)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LovelaceError)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LovelaceError -> m LovelaceError
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LovelaceError -> m LovelaceError
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LovelaceError -> m LovelaceError
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LovelaceError -> m LovelaceError
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LovelaceError -> m LovelaceError
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LovelaceError -> m LovelaceError
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LovelaceError -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LovelaceError -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> LovelaceError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LovelaceError -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LovelaceError -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LovelaceError -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LovelaceError -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LovelaceError -> r
gmapT :: (forall b. Data b => b -> b) -> LovelaceError -> LovelaceError
$cgmapT :: (forall b. Data b => b -> b) -> LovelaceError -> LovelaceError
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LovelaceError)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LovelaceError)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LovelaceError)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LovelaceError)
dataTypeOf :: LovelaceError -> DataType
$cdataTypeOf :: LovelaceError -> DataType
toConstr :: LovelaceError -> Constr
$ctoConstr :: LovelaceError -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LovelaceError
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LovelaceError
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LovelaceError -> c LovelaceError
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LovelaceError -> c LovelaceError
Data, LovelaceError -> LovelaceError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LovelaceError -> LovelaceError -> Bool
$c/= :: LovelaceError -> LovelaceError -> Bool
== :: LovelaceError -> LovelaceError -> Bool
$c== :: LovelaceError -> LovelaceError -> Bool
Eq, Int -> LovelaceError -> ShowS
[LovelaceError] -> ShowS
LovelaceError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LovelaceError] -> ShowS
$cshowList :: [LovelaceError] -> ShowS
show :: LovelaceError -> String
$cshow :: LovelaceError -> String
showsPrec :: Int -> LovelaceError -> ShowS
$cshowsPrec :: Int -> LovelaceError -> ShowS
Show)

instance B.Buildable LovelaceError where
  build :: LovelaceError -> Builder
build = \case
    LovelaceOverflow Word64
c ->
      forall a. Format Builder a -> a
bprint
        (Format (Word64 -> Builder) (Word64 -> Builder)
"Lovelace value, " 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
", overflowed")
        Word64
c
    LovelaceTooLarge Integer
c ->
      forall a. Format Builder a -> a
bprint
        (Format
  (Integer -> Word64 -> Builder) (Integer -> Word64 -> Builder)
"Lovelace value, " 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 (Word64 -> Builder) (Word64 -> Builder)
", exceeds maximum, " 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)
        Integer
c
        Word64
maxLovelaceVal
    LovelaceTooSmall Integer
c ->
      forall a. Format Builder a -> a
bprint
        (Format
  (Integer -> Lovelace -> Builder) (Integer -> Lovelace -> Builder)
"Lovelace value, " 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 (Lovelace -> Builder) (Lovelace -> Builder)
", is less than minimum, " 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)
        Integer
c
        (forall a. Bounded a => a
minBound :: Lovelace)
    LovelaceUnderflow Word64
c Word64
c' ->
      forall a. Format Builder a -> a
bprint
        (Format (Word64 -> Word64 -> Builder) (Word64 -> Word64 -> Builder)
"Lovelace underflow when subtracting " 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 (Word64 -> Builder) (Word64 -> Builder)
" from " 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)
        Word64
c'
        Word64
c

instance ToCBOR LovelaceError where
  toCBOR :: LovelaceError -> Encoding
toCBOR = forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR LovelaceError where
  fromCBOR :: forall s. Decoder s LovelaceError
fromCBOR = forall a s. DecCBOR a => Decoder s a
fromByronCBOR

instance EncCBOR LovelaceError where
  encCBOR :: LovelaceError -> Encoding
encCBOR = \case
    LovelaceOverflow Word64
c ->
      Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR @Word8 Word8
0 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Word64
c
    LovelaceTooLarge Integer
c ->
      Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR @Word8 Word8
1 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Integer
c
    LovelaceTooSmall Integer
c ->
      Word -> Encoding
encodeListLen Word
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR @Word8 Word8
2 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Integer
c
    LovelaceUnderflow Word64
c Word64
c' ->
      Word -> Encoding
encodeListLen Word
3 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR @Word8 Word8
3 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Word64
c forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR Word64
c'

instance DecCBOR LovelaceError where
  decCBOR :: forall s. Decoder s LovelaceError
decCBOR = do
    Int
len <- forall s. Decoder s Int
decodeListLen
    let checkSize :: Int -> Decoder s ()
checkSize Int
size = forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"LovelaceError" Int
size Int
len
    Word8
tag <- forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> Int -> Decoder s ()
checkSize Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> LovelaceError
LovelaceOverflow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
1 -> Int -> Decoder s ()
checkSize Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> LovelaceError
LovelaceTooLarge forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
2 -> Int -> Decoder s ()
checkSize Int
2 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> LovelaceError
LovelaceTooSmall forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
3 -> Int -> Decoder s ()
checkSize Int
3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Word64 -> LovelaceError
LovelaceUnderflow forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a s. DecCBOR a => Decoder s a
decCBOR forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a s. DecCBOR a => Decoder s a
decCBOR
      Word8
_ -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"TxValidationError" Word8
tag

-- | Maximal possible value of 'Lovelace'
maxLovelaceVal :: Word64
maxLovelaceVal :: Word64
maxLovelaceVal = Word64
45e15

-- | Constructor for 'Lovelace' returning 'LovelaceError' when @c@ exceeds
--   'maxLovelaceVal'
mkLovelace :: Word64 -> Either LovelaceError Lovelace
mkLovelace :: Word64 -> Either LovelaceError Lovelace
mkLovelace Word64
c
  | Word64
c forall a. Ord a => a -> a -> Bool
<= Word64
maxLovelaceVal = forall a b. b -> Either a b
Right (Word64 -> Lovelace
Lovelace Word64
c)
  | Bool
otherwise = forall a b. a -> Either a b
Left (Integer -> LovelaceError
LovelaceTooLarge (forall a. Integral a => a -> Integer
toInteger Word64
c))
{-# INLINE mkLovelace #-}

-- | Construct a 'Lovelace' from a 'KnownNat', known to be less than
--   'maxLovelaceVal'
mkKnownLovelace :: forall n. (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace :: forall (n :: Nat). (KnownNat n, n <= 45000000000000000) => Lovelace
mkKnownLovelace = Word64 -> Lovelace
Lovelace 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. (Integral a, Num b) => a -> b
fromIntegral forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @n

-- | Lovelace formatter which restricts type.
lovelaceF :: Format r (Lovelace -> r)
lovelaceF :: forall r. Format r (Lovelace -> r)
lovelaceF = forall a r. Buildable a => Format r (a -> r)
build

-- | Unwraps 'Lovelace'. It's called “unsafe” so that people wouldn't use it
--   willy-nilly if they want to sum lovelace or something. It's actually safe.
unsafeGetLovelace :: Lovelace -> Word64
unsafeGetLovelace :: Lovelace -> Word64
unsafeGetLovelace = Lovelace -> Word64
unLovelace
{-# INLINE unsafeGetLovelace #-}

-- | Compute sum of all lovelace in container. Result is 'Integer' as a
--   protection against possible overflow.
sumLovelace ::
  (Foldable t, Functor t) => t Lovelace -> Either LovelaceError Lovelace
sumLovelace :: forall (t :: * -> *).
(Foldable t, Functor t) =>
t Lovelace -> Either LovelaceError Lovelace
sumLovelace = Integer -> Either LovelaceError Lovelace
integerToLovelace forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Lovelace -> Integer
lovelaceToInteger

lovelaceToInteger :: Lovelace -> Integer
lovelaceToInteger :: Lovelace -> Integer
lovelaceToInteger = forall a. Integral a => a -> Integer
toInteger forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Lovelace -> Word64
unsafeGetLovelace
{-# INLINE lovelaceToInteger #-}

-- | Addition of lovelace, returning 'LovelaceError' in case of overflow
addLovelace :: Lovelace -> Lovelace -> Either LovelaceError Lovelace
addLovelace :: Lovelace -> Lovelace -> Either LovelaceError Lovelace
addLovelace (Lovelace Word64
a) (Lovelace Word64
b)
  | Word64
res forall a. Ord a => a -> a -> Bool
>= Word64
a Bool -> Bool -> Bool
&& Word64
res forall a. Ord a => a -> a -> Bool
>= Word64
b Bool -> Bool -> Bool
&& Word64
res forall a. Ord a => a -> a -> Bool
<= Word64
maxLovelaceVal = forall a b. b -> Either a b
Right (Word64 -> Lovelace
Lovelace Word64
res)
  | Bool
otherwise = forall a b. a -> Either a b
Left (Word64 -> LovelaceError
LovelaceOverflow Word64
res)
  where
    res :: Word64
res = Word64
a forall a. Num a => a -> a -> a
+ Word64
b
{-# INLINE addLovelace #-}

-- | Subtraction of lovelace, returning 'LovelaceError' on underflow
subLovelace :: Lovelace -> Lovelace -> Either LovelaceError Lovelace
subLovelace :: Lovelace -> Lovelace -> Either LovelaceError Lovelace
subLovelace (Lovelace Word64
a) (Lovelace Word64
b)
  | Word64
a forall a. Ord a => a -> a -> Bool
>= Word64
b = forall a b. b -> Either a b
Right (Word64 -> Lovelace
Lovelace (Word64
a forall a. Num a => a -> a -> a
- Word64
b))
  | Bool
otherwise = forall a b. a -> Either a b
Left (Word64 -> Word64 -> LovelaceError
LovelaceUnderflow Word64
a Word64
b)

-- | Scale a 'Lovelace' by an 'Integral' factor, returning 'LovelaceError' when
--   the result is too large
scaleLovelace :: Integral b => Lovelace -> b -> Either LovelaceError Lovelace
scaleLovelace :: forall b.
Integral b =>
Lovelace -> b -> Either LovelaceError Lovelace
scaleLovelace (Lovelace Word64
a) b
b = Integer -> Either LovelaceError Lovelace
integerToLovelace forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger Word64
a forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Integer
toInteger b
b
{-# INLINE scaleLovelace #-}

-- | Scale a 'Lovelace' by a rational factor, rounding down.
scaleLovelaceRational :: Lovelace -> Rational -> Lovelace
scaleLovelaceRational :: Lovelace -> Rational -> Lovelace
scaleLovelaceRational (Lovelace Word64
a) Rational
b =
  Word64 -> Lovelace
Lovelace forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger Word64
a forall a. Num a => a -> a -> a
* Integer
n forall a. Integral a => a -> a -> a
`div` Integer
d
  where
    n, d :: Integer
    n :: Integer
n = forall a. Ratio a -> a
numerator Rational
b
    d :: Integer
d = forall a. Ratio a -> a
denominator Rational
b

-- | Scale a 'Lovelace' by a rational factor, rounding up.
scaleLovelaceRationalUp :: Lovelace -> Rational -> Lovelace
scaleLovelaceRationalUp :: Lovelace -> Rational -> Lovelace
scaleLovelaceRationalUp (Lovelace Word64
a) Rational
b =
  Word64 -> Lovelace
Lovelace forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
ceiling forall a b. (a -> b) -> a -> b
$ forall a. Real a => a -> Rational
toRational Word64
a forall a. Num a => a -> a -> a
* Rational
b

-- | Integer division of a 'Lovelace' by an 'Integral' factor
divLovelace :: Integral b => Lovelace -> b -> Either LovelaceError Lovelace
divLovelace :: forall b.
Integral b =>
Lovelace -> b -> Either LovelaceError Lovelace
divLovelace (Lovelace Word64
a) b
b = Integer -> Either LovelaceError Lovelace
integerToLovelace forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger Word64
a forall a. Integral a => a -> a -> a
`div` forall a. Integral a => a -> Integer
toInteger b
b
{-# INLINE divLovelace #-}

-- | Integer modulus of a 'Lovelace' by an 'Integral' factor
modLovelace :: Integral b => Lovelace -> b -> Either LovelaceError Lovelace
modLovelace :: forall b.
Integral b =>
Lovelace -> b -> Either LovelaceError Lovelace
modLovelace (Lovelace Word64
a) b
b = Integer -> Either LovelaceError Lovelace
integerToLovelace forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger Word64
a forall a. Integral a => a -> a -> a
`mod` forall a. Integral a => a -> Integer
toInteger b
b
{-# INLINE modLovelace #-}

integerToLovelace :: Integer -> Either LovelaceError Lovelace
integerToLovelace :: Integer -> Either LovelaceError Lovelace
integerToLovelace Integer
n
  | Integer
n forall a. Ord a => a -> a -> Bool
< Integer
0 = forall a b. a -> Either a b
Left (Integer -> LovelaceError
LovelaceTooSmall Integer
n)
  | Integer
n forall a. Ord a => a -> a -> Bool
<= Lovelace -> Integer
lovelaceToInteger (forall a. Bounded a => a
maxBound :: Lovelace) =
      forall a b. b -> Either a b
Right
        forall a b. (a -> b) -> a -> b
$ Word64 -> Lovelace
Lovelace (forall a. Num a => Integer -> a
fromInteger Integer
n)
  | Bool
otherwise = forall a b. a -> Either a b
Left (Integer -> LovelaceError
LovelaceTooLarge Integer
n)