{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# 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.Binary
  ( DecoderError (..),
    FromCBOR (..),
    ToCBOR (..),
    decodeListLen,
    decodeWord8,
    encodeListLen,
    matchSize,
  )
import Cardano.Prelude
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
Eq Lovelace
-> (Lovelace -> Lovelace -> Ordering)
-> (Lovelace -> Lovelace -> Bool)
-> (Lovelace -> Lovelace -> Bool)
-> (Lovelace -> Lovelace -> Bool)
-> (Lovelace -> Lovelace -> Bool)
-> (Lovelace -> Lovelace -> Lovelace)
-> (Lovelace -> Lovelace -> Lovelace)
-> Ord 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
$cp1Ord :: Eq Lovelace
Ord, Lovelace -> Lovelace -> Bool
(Lovelace -> Lovelace -> Bool)
-> (Lovelace -> Lovelace -> Bool) -> Eq Lovelace
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. Lovelace -> Rep Lovelace x)
-> (forall x. Rep Lovelace x -> Lovelace) -> Generic Lovelace
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
DataType
Constr
Typeable Lovelace
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Lovelace -> c Lovelace)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Lovelace)
-> (Lovelace -> Constr)
-> (Lovelace -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Lovelace -> Lovelace)
-> (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 u. (forall d. Data d => d -> u) -> Lovelace -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Lovelace -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Lovelace -> m Lovelace)
-> Data Lovelace
Lovelace -> DataType
Lovelace -> Constr
(forall b. Data b => b -> b) -> Lovelace -> Lovelace
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Lovelace -> c Lovelace
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cLovelace :: Constr
$tLovelace :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Lovelace -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Lovelace -> u
gmapQ :: (forall d. Data d => d -> u) -> Lovelace -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Lovelace -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Lovelace
Data, Lovelace -> ()
(Lovelace -> ()) -> NFData Lovelace
forall a. (a -> ()) -> NFData a
rnf :: Lovelace -> ()
$crnf :: Lovelace -> ()
NFData, Context -> Lovelace -> IO (Maybe ThunkInfo)
Proxy Lovelace -> String
(Context -> Lovelace -> IO (Maybe ThunkInfo))
-> (Context -> Lovelace -> IO (Maybe ThunkInfo))
-> (Proxy Lovelace -> String)
-> NoThunks Lovelace
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
(Int -> Lovelace -> ShowS)
-> (Lovelace -> String) -> ([Lovelace] -> ShowS) -> Show Lovelace
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) = Format Builder (Word64 -> Builder) -> Word64 -> Builder
forall a. Format Builder a -> a
bprint (Format Builder (Word64 -> Builder)
forall a r. Integral a => Format r (a -> r)
int Format Builder (Word64 -> Builder)
-> Format Builder Builder -> Format Builder (Word64 -> Builder)
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 = Word64 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word64 -> Encoding)
-> (Lovelace -> Word64) -> Lovelace -> Encoding
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. ToCBOR t => Proxy t -> Size) -> Proxy Lovelace -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy Lovelace
pxy = Proxy Word64 -> Size
forall t. ToCBOR t => Proxy t -> Size
size (Lovelace -> Word64
unsafeGetLovelace (Lovelace -> Word64) -> Proxy Lovelace -> Proxy Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy Lovelace
pxy)

instance FromCBOR Lovelace where
  fromCBOR :: Decoder s Lovelace
fromCBOR = do
    Word64
l <- Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
    Either DecoderError Lovelace -> Decoder s Lovelace
forall e a s. Buildable e => Either e a -> Decoder s a
toCborError
      (Either DecoderError Lovelace -> Decoder s Lovelace)
-> (Either LovelaceError Lovelace -> Either DecoderError Lovelace)
-> Either LovelaceError Lovelace
-> Decoder s Lovelace
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (LovelaceError -> DecoderError)
-> Either LovelaceError Lovelace -> Either DecoderError Lovelace
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Text -> DecoderError
DecoderErrorCustom Text
"Lovelace" (Text -> DecoderError)
-> (LovelaceError -> Text) -> LovelaceError -> DecoderError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Text (LovelaceError -> Text) -> LovelaceError -> Text
forall a. Format Text a -> a
sformat Format Text (LovelaceError -> Text)
forall a r. Buildable a => Format r (a -> r)
build)
      (Either LovelaceError Lovelace -> Decoder s Lovelace)
-> Either LovelaceError Lovelace -> Decoder s Lovelace
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 = Word64 -> m JSValue
forall (m :: * -> *) a. ToJSON m a => a -> m JSValue
Canonical.toJSON (Word64 -> m JSValue)
-> (Lovelace -> Word64) -> Lovelace -> m JSValue
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 = (Word64 -> Lovelace) -> m Word64 -> m Lovelace
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Lovelace
Lovelace (m Word64 -> m Lovelace)
-> (JSValue -> m Word64) -> JSValue -> m Lovelace
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JSValue -> m Word64
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
DataType
Constr
Typeable LovelaceError
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LovelaceError -> c LovelaceError)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LovelaceError)
-> (LovelaceError -> Constr)
-> (LovelaceError -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> LovelaceError -> LovelaceError)
-> (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 u. (forall d. Data d => d -> u) -> LovelaceError -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LovelaceError -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LovelaceError -> m LovelaceError)
-> Data LovelaceError
LovelaceError -> DataType
LovelaceError -> Constr
(forall b. Data b => b -> b) -> LovelaceError -> LovelaceError
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LovelaceError -> c LovelaceError
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cLovelaceUnderflow :: Constr
$cLovelaceTooSmall :: Constr
$cLovelaceTooLarge :: Constr
$cLovelaceOverflow :: Constr
$tLovelaceError :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> LovelaceError -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LovelaceError -> u
gmapQ :: (forall d. Data d => d -> u) -> LovelaceError -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LovelaceError -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable LovelaceError
Data, LovelaceError -> LovelaceError -> Bool
(LovelaceError -> LovelaceError -> Bool)
-> (LovelaceError -> LovelaceError -> Bool) -> Eq LovelaceError
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
(Int -> LovelaceError -> ShowS)
-> (LovelaceError -> String)
-> ([LovelaceError] -> ShowS)
-> Show LovelaceError
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 ->
      Format Builder (Word64 -> Builder) -> Word64 -> Builder
forall a. Format Builder a -> a
bprint
        (Format (Word64 -> Builder) (Word64 -> Builder)
"Lovelace value, " Format (Word64 -> Builder) (Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Word64 -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format Builder (Word64 -> Builder)
-> Format Builder Builder -> Format Builder (Word64 -> Builder)
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 ->
      Format Builder (Integer -> Word64 -> Builder)
-> Integer -> Word64 -> Builder
forall a. Format Builder a -> a
bprint
        (Format
  (Integer -> Word64 -> Builder) (Integer -> Word64 -> Builder)
"Lovelace value, " Format
  (Integer -> Word64 -> Builder) (Integer -> Word64 -> Builder)
-> Format Builder (Integer -> Word64 -> Builder)
-> Format Builder (Integer -> Word64 -> Builder)
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) (Integer -> Word64 -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format (Word64 -> Builder) (Integer -> Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
-> Format Builder (Integer -> Word64 -> Builder)
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, " Format (Word64 -> Builder) (Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Word64 -> Builder)
forall a r. Buildable a => Format r (a -> r)
build)
        Integer
c
        Word64
maxLovelaceVal
    LovelaceTooSmall Integer
c ->
      Format Builder (Integer -> Lovelace -> Builder)
-> Integer -> Lovelace -> Builder
forall a. Format Builder a -> a
bprint
        (Format
  (Integer -> Lovelace -> Builder) (Integer -> Lovelace -> Builder)
"Lovelace value, " Format
  (Integer -> Lovelace -> Builder) (Integer -> Lovelace -> Builder)
-> Format Builder (Integer -> Lovelace -> Builder)
-> Format Builder (Integer -> Lovelace -> Builder)
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) (Integer -> Lovelace -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format (Lovelace -> Builder) (Integer -> Lovelace -> Builder)
-> Format Builder (Lovelace -> Builder)
-> Format Builder (Integer -> Lovelace -> Builder)
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, " Format (Lovelace -> Builder) (Lovelace -> Builder)
-> Format Builder (Lovelace -> Builder)
-> Format Builder (Lovelace -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Lovelace -> Builder)
forall a r. Buildable a => Format r (a -> r)
build)
        Integer
c
        (Lovelace
forall a. Bounded a => a
minBound :: Lovelace)
    LovelaceUnderflow Word64
c Word64
c' ->
      Format Builder (Word64 -> Word64 -> Builder)
-> Word64 -> Word64 -> Builder
forall a. Format Builder a -> a
bprint
        (Format (Word64 -> Word64 -> Builder) (Word64 -> Word64 -> Builder)
"Lovelace underflow when subtracting " Format (Word64 -> Word64 -> Builder) (Word64 -> Word64 -> Builder)
-> Format Builder (Word64 -> Word64 -> Builder)
-> Format Builder (Word64 -> Word64 -> Builder)
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 -> Word64 -> Builder)
forall a r. Buildable a => Format r (a -> r)
build Format (Word64 -> Builder) (Word64 -> Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
-> Format Builder (Word64 -> Word64 -> Builder)
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 " Format (Word64 -> Builder) (Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
-> Format Builder (Word64 -> Builder)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Format Builder (Word64 -> Builder)
forall a r. Buildable a => Format r (a -> r)
build)
        Word64
c'
        Word64
c

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

instance FromCBOR LovelaceError where
  fromCBOR :: Decoder s LovelaceError
fromCBOR = do
    Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
    let checkSize :: Int -> Decoder s ()
checkSize Int
size = Text -> Int -> Int -> Decoder s ()
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"LovelaceError" Int
size Int
len
    Word8
tag <- Decoder s Word8
forall s. Decoder s Word8
decodeWord8
    case Word8
tag of
      Word8
0 -> Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s LovelaceError -> Decoder s LovelaceError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> LovelaceError
LovelaceOverflow (Word64 -> LovelaceError)
-> Decoder s Word64 -> Decoder s LovelaceError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
1 -> Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s LovelaceError -> Decoder s LovelaceError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> LovelaceError
LovelaceTooLarge (Integer -> LovelaceError)
-> Decoder s Integer -> Decoder s LovelaceError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
2 -> Int -> Decoder s ()
checkSize Int
2 Decoder s () -> Decoder s LovelaceError -> Decoder s LovelaceError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Integer -> LovelaceError
LovelaceTooSmall (Integer -> LovelaceError)
-> Decoder s Integer -> Decoder s LovelaceError
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Integer
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
3 -> Int -> Decoder s ()
checkSize Int
3 Decoder s () -> Decoder s LovelaceError -> Decoder s LovelaceError
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word64 -> Word64 -> LovelaceError
LovelaceUnderflow (Word64 -> Word64 -> LovelaceError)
-> Decoder s Word64 -> Decoder s (Word64 -> LovelaceError)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (Word64 -> LovelaceError)
-> Decoder s Word64 -> Decoder s LovelaceError
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s Word64
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Word8
_ -> DecoderError -> Decoder s LovelaceError
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Decoder s LovelaceError)
-> DecoderError -> Decoder s LovelaceError
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 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
maxLovelaceVal = Lovelace -> Either LovelaceError Lovelace
forall a b. b -> Either a b
Right (Word64 -> Lovelace
Lovelace Word64
c)
  | Bool
otherwise = LovelaceError -> Either LovelaceError Lovelace
forall a b. a -> Either a b
Left (Integer -> LovelaceError
LovelaceTooLarge (Word64 -> Integer
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 :: Lovelace
mkKnownLovelace = Word64 -> Lovelace
Lovelace (Word64 -> Lovelace) -> (Proxy n -> Word64) -> Proxy n -> Lovelace
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> (Proxy n -> Integer) -> Proxy n -> Word64
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Proxy n -> Integer
forall (n :: Nat) (proxy :: Nat -> *).
KnownNat n =>
proxy n -> Integer
natVal (Proxy n -> Lovelace) -> Proxy n -> Lovelace
forall a b. (a -> b) -> a -> b
$ Proxy n
forall k (t :: k). Proxy t
Proxy @n

-- | Lovelace formatter which restricts type.
lovelaceF :: Format r (Lovelace -> r)
lovelaceF :: Format r (Lovelace -> r)
lovelaceF = Format r (Lovelace -> r)
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 :: t Lovelace -> Either LovelaceError Lovelace
sumLovelace = Integer -> Either LovelaceError Lovelace
integerToLovelace (Integer -> Either LovelaceError Lovelace)
-> (t Lovelace -> Integer)
-> t Lovelace
-> Either LovelaceError Lovelace
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. t Integer -> Integer
forall (f :: * -> *) a. (Foldable f, Num a) => f a -> a
sum (t Integer -> Integer)
-> (t Lovelace -> t Integer) -> t Lovelace -> Integer
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Lovelace -> Integer) -> t Lovelace -> t Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map Lovelace -> Integer
lovelaceToInteger

lovelaceToInteger :: Lovelace -> Integer
lovelaceToInteger :: Lovelace -> Integer
lovelaceToInteger = Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> (Lovelace -> Word64) -> Lovelace -> Integer
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 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
a Bool -> Bool -> Bool
&& Word64
res Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
b Bool -> Bool -> Bool
&& Word64
res Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
maxLovelaceVal = Lovelace -> Either LovelaceError Lovelace
forall a b. b -> Either a b
Right (Word64 -> Lovelace
Lovelace Word64
res)
  | Bool
otherwise = LovelaceError -> Either LovelaceError Lovelace
forall a b. a -> Either a b
Left (Word64 -> LovelaceError
LovelaceOverflow Word64
res)
  where
    res :: Word64
res = Word64
a Word64 -> Word64 -> Word64
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 Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
b = Lovelace -> Either LovelaceError Lovelace
forall a b. b -> Either a b
Right (Word64 -> Lovelace
Lovelace (Word64
a Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
b))
  | Bool
otherwise = LovelaceError -> Either LovelaceError Lovelace
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 :: Lovelace -> b -> Either LovelaceError Lovelace
scaleLovelace (Lovelace Word64
a) b
b = Integer -> Either LovelaceError Lovelace
integerToLovelace (Integer -> Either LovelaceError Lovelace)
-> Integer -> Either LovelaceError Lovelace
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* b -> Integer
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 (Word64 -> Lovelace) -> Word64 -> Lovelace
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
d
  where
    n, d :: Integer
    n :: Integer
n = Rational -> Integer
forall a. Ratio a -> a
numerator Rational
b
    d :: Integer
d = Rational -> Integer
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 (Word64 -> Lovelace) -> Word64 -> Lovelace
forall a b. (a -> b) -> a -> b
$ Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Rational -> Integer) -> Rational -> Integer
forall a b. (a -> b) -> a -> b
$ Word64 -> Rational
forall a. Real a => a -> Rational
toRational Word64
a Rational -> Rational -> Rational
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 :: Lovelace -> b -> Either LovelaceError Lovelace
divLovelace (Lovelace Word64
a) b
b = Integer -> Either LovelaceError Lovelace
integerToLovelace (Integer -> Either LovelaceError Lovelace)
-> Integer -> Either LovelaceError Lovelace
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` b -> Integer
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 :: Lovelace -> b -> Either LovelaceError Lovelace
modLovelace (Lovelace Word64
a) b
b = Integer -> Either LovelaceError Lovelace
integerToLovelace (Integer -> Either LovelaceError Lovelace)
-> Integer -> Either LovelaceError Lovelace
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger Word64
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` b -> Integer
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 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 = LovelaceError -> Either LovelaceError Lovelace
forall a b. a -> Either a b
Left (Integer -> LovelaceError
LovelaceTooSmall Integer
n)
  | Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Lovelace -> Integer
lovelaceToInteger (Lovelace
forall a. Bounded a => a
maxBound :: Lovelace) =
      Lovelace -> Either LovelaceError Lovelace
forall a b. b -> Either a b
Right (Lovelace -> Either LovelaceError Lovelace)
-> Lovelace -> Either LovelaceError Lovelace
forall a b. (a -> b) -> a -> b
$
        Word64 -> Lovelace
Lovelace (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
n)
  | Bool
otherwise = LovelaceError -> Either LovelaceError Lovelace
forall a b. a -> Either a b
Left (Integer -> LovelaceError
LovelaceTooLarge Integer
n)