{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-name-shadowing #-}
module Plutus.Contracts.Stablecoin(
SC(..)
, RC(..)
, BC(..)
, PC(..)
, BankState(..)
, Stablecoin(..)
, Input(..)
, SCAction(..)
, ConversionRate
, typedValidator
, machineClient
, step
, contract
, StablecoinError
, StablecoinSchema
, stableCoins
, reserveCoins
, checkValidState
) where
import Control.Lens (makeClassyPrisms)
import Control.Monad (forever, guard)
import Data.Aeson (FromJSON, ToJSON)
import Data.Functor.Identity (Identity (..))
import GHC.Generics (Generic)
import Ledger.Address (PaymentPubKey)
import Ledger.Scripts (MintingPolicyHash)
import Ledger.Tx.Constraints (TxConstraints)
import Ledger.Tx.Constraints qualified as Constraints
import Ledger.Tx.Constraints.ValidityInterval qualified as Interval
import Ledger.Typed.Scripts qualified as Scripts
import Plutus.Contract
import Plutus.Contract.Oracle
import Plutus.Contract.StateMachine (AsSMContractError, SMContractError, State (..), StateMachine,
StateMachineClient (..), Void)
import Plutus.Contract.StateMachine qualified as SM
import Plutus.Script.Utils.Ada qualified as Ada
import Plutus.Script.Utils.V2.Typed.Scripts as V2
import Plutus.Script.Utils.Value (AssetClass, TokenName, Value)
import Plutus.Script.Utils.Value qualified as Value
import PlutusTx qualified
import PlutusTx.Prelude
import PlutusTx.Ratio qualified as R
import Prelude qualified as Haskell
type ConversionRate = Rational
newtype SC a = SC { SC a -> a
unSC :: a }
deriving newtype (Integer -> SC a
SC a -> SC a
SC a -> SC a -> SC a
(SC a -> SC a -> SC a)
-> (SC a -> SC a -> SC a)
-> (SC a -> SC a -> SC a)
-> (SC a -> SC a)
-> (SC a -> SC a)
-> (SC a -> SC a)
-> (Integer -> SC a)
-> Num (SC a)
forall a. Num a => Integer -> SC a
forall a. Num a => SC a -> SC a
forall a. Num a => SC a -> SC a -> SC a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> SC a
$cfromInteger :: forall a. Num a => Integer -> SC a
signum :: SC a -> SC a
$csignum :: forall a. Num a => SC a -> SC a
abs :: SC a -> SC a
$cabs :: forall a. Num a => SC a -> SC a
negate :: SC a -> SC a
$cnegate :: forall a. Num a => SC a -> SC a
* :: SC a -> SC a -> SC a
$c* :: forall a. Num a => SC a -> SC a -> SC a
- :: SC a -> SC a -> SC a
$c- :: forall a. Num a => SC a -> SC a -> SC a
+ :: SC a -> SC a -> SC a
$c+ :: forall a. Num a => SC a -> SC a -> SC a
Haskell.Num, SC a -> SC a -> Bool
(SC a -> SC a -> Bool) -> Eq (SC a)
forall a. Eq a => SC a -> SC a -> Bool
forall a. (a -> a -> Bool) -> Eq a
== :: SC a -> SC a -> Bool
$c== :: forall a. Eq a => SC a -> SC a -> Bool
Eq, Eq (SC a)
Eq (SC a)
-> (SC a -> SC a -> Ordering)
-> (SC a -> SC a -> Bool)
-> (SC a -> SC a -> Bool)
-> (SC a -> SC a -> Bool)
-> (SC a -> SC a -> Bool)
-> (SC a -> SC a -> SC a)
-> (SC a -> SC a -> SC a)
-> Ord (SC a)
SC a -> SC a -> Bool
SC a -> SC a -> Ordering
SC a -> SC a -> SC a
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
forall a. Ord a => Eq (SC a)
forall a. Ord a => SC a -> SC a -> Bool
forall a. Ord a => SC a -> SC a -> Ordering
forall a. Ord a => SC a -> SC a -> SC a
min :: SC a -> SC a -> SC a
$cmin :: forall a. Ord a => SC a -> SC a -> SC a
max :: SC a -> SC a -> SC a
$cmax :: forall a. Ord a => SC a -> SC a -> SC a
>= :: SC a -> SC a -> Bool
$c>= :: forall a. Ord a => SC a -> SC a -> Bool
> :: SC a -> SC a -> Bool
$c> :: forall a. Ord a => SC a -> SC a -> Bool
<= :: SC a -> SC a -> Bool
$c<= :: forall a. Ord a => SC a -> SC a -> Bool
< :: SC a -> SC a -> Bool
$c< :: forall a. Ord a => SC a -> SC a -> Bool
compare :: SC a -> SC a -> Ordering
$ccompare :: forall a. Ord a => SC a -> SC a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (SC a)
Ord, AdditiveMonoid (SC a)
AdditiveMonoid (SC a)
-> (SC a -> SC a -> SC a) -> AdditiveGroup (SC a)
SC a -> SC a -> SC a
forall a. AdditiveGroup a => AdditiveMonoid (SC a)
forall a. AdditiveGroup a => SC a -> SC a -> SC a
forall a. AdditiveMonoid a -> (a -> a -> a) -> AdditiveGroup a
- :: SC a -> SC a -> SC a
$c- :: forall a. AdditiveGroup a => SC a -> SC a -> SC a
$cp1AdditiveGroup :: forall a. AdditiveGroup a => AdditiveMonoid (SC a)
AdditiveGroup, AdditiveSemigroup (SC a)
SC a
AdditiveSemigroup (SC a) -> SC a -> AdditiveMonoid (SC a)
forall a. AdditiveMonoid a => AdditiveSemigroup (SC a)
forall a. AdditiveMonoid a => SC a
forall a. AdditiveSemigroup a -> a -> AdditiveMonoid a
zero :: SC a
$czero :: forall a. AdditiveMonoid a => SC a
$cp1AdditiveMonoid :: forall a. AdditiveMonoid a => AdditiveSemigroup (SC a)
AdditiveMonoid, SC a -> SC a -> SC a
(SC a -> SC a -> SC a) -> AdditiveSemigroup (SC a)
forall a. AdditiveSemigroup a => SC a -> SC a -> SC a
forall a. (a -> a -> a) -> AdditiveSemigroup a
+ :: SC a -> SC a -> SC a
$c+ :: forall a. AdditiveSemigroup a => SC a -> SC a -> SC a
AdditiveSemigroup, SC a -> SC a -> SC a
(SC a -> SC a -> SC a) -> MultiplicativeSemigroup (SC a)
forall a. MultiplicativeSemigroup a => SC a -> SC a -> SC a
forall a. (a -> a -> a) -> MultiplicativeSemigroup a
* :: SC a -> SC a -> SC a
$c* :: forall a. MultiplicativeSemigroup a => SC a -> SC a -> SC a
MultiplicativeSemigroup)
deriving stock ((forall x. SC a -> Rep (SC a) x)
-> (forall x. Rep (SC a) x -> SC a) -> Generic (SC a)
forall x. Rep (SC a) x -> SC a
forall x. SC a -> Rep (SC a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (SC a) x -> SC a
forall a x. SC a -> Rep (SC a) x
$cto :: forall a x. Rep (SC a) x -> SC a
$cfrom :: forall a x. SC a -> Rep (SC a) x
Generic, SC a -> SC a -> Bool
(SC a -> SC a -> Bool) -> (SC a -> SC a -> Bool) -> Eq (SC a)
forall a. Eq a => SC a -> SC a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SC a -> SC a -> Bool
$c/= :: forall a. Eq a => SC a -> SC a -> Bool
== :: SC a -> SC a -> Bool
$c== :: forall a. Eq a => SC a -> SC a -> Bool
Haskell.Eq, Int -> SC a -> ShowS
[SC a] -> ShowS
SC a -> String
(Int -> SC a -> ShowS)
-> (SC a -> String) -> ([SC a] -> ShowS) -> Show (SC a)
forall a. Show a => Int -> SC a -> ShowS
forall a. Show a => [SC a] -> ShowS
forall a. Show a => SC a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SC a] -> ShowS
$cshowList :: forall a. Show a => [SC a] -> ShowS
show :: SC a -> String
$cshow :: forall a. Show a => SC a -> String
showsPrec :: Int -> SC a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> SC a -> ShowS
Haskell.Show)
deriving anyclass ([SC a] -> Encoding
[SC a] -> Value
SC a -> Encoding
SC a -> Value
(SC a -> Value)
-> (SC a -> Encoding)
-> ([SC a] -> Value)
-> ([SC a] -> Encoding)
-> ToJSON (SC a)
forall a. ToJSON a => [SC a] -> Encoding
forall a. ToJSON a => [SC a] -> Value
forall a. ToJSON a => SC a -> Encoding
forall a. ToJSON a => SC a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SC a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [SC a] -> Encoding
toJSONList :: [SC a] -> Value
$ctoJSONList :: forall a. ToJSON a => [SC a] -> Value
toEncoding :: SC a -> Encoding
$ctoEncoding :: forall a. ToJSON a => SC a -> Encoding
toJSON :: SC a -> Value
$ctoJSON :: forall a. ToJSON a => SC a -> Value
ToJSON, Value -> Parser [SC a]
Value -> Parser (SC a)
(Value -> Parser (SC a))
-> (Value -> Parser [SC a]) -> FromJSON (SC a)
forall a. FromJSON a => Value -> Parser [SC a]
forall a. FromJSON a => Value -> Parser (SC a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SC a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [SC a]
parseJSON :: Value -> Parser (SC a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (SC a)
FromJSON)
deriving (a -> b) -> SC a -> SC b
(forall a b. (a -> b) -> SC a -> SC b) -> Functor SC
forall a b. (a -> b) -> SC a -> SC b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b) -> Functor f
fmap :: (a -> b) -> SC a -> SC b
$cfmap :: forall a b. (a -> b) -> SC a -> SC b
Functor via Identity
newtype RC a = RC { RC a -> a
unRC :: a }
deriving newtype (Integer -> RC a
RC a -> RC a
RC a -> RC a -> RC a
(RC a -> RC a -> RC a)
-> (RC a -> RC a -> RC a)
-> (RC a -> RC a -> RC a)
-> (RC a -> RC a)
-> (RC a -> RC a)
-> (RC a -> RC a)
-> (Integer -> RC a)
-> Num (RC a)
forall a. Num a => Integer -> RC a
forall a. Num a => RC a -> RC a
forall a. Num a => RC a -> RC a -> RC a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> RC a
$cfromInteger :: forall a. Num a => Integer -> RC a
signum :: RC a -> RC a
$csignum :: forall a. Num a => RC a -> RC a
abs :: RC a -> RC a
$cabs :: forall a. Num a => RC a -> RC a
negate :: RC a -> RC a
$cnegate :: forall a. Num a => RC a -> RC a
* :: RC a -> RC a -> RC a
$c* :: forall a. Num a => RC a -> RC a -> RC a
- :: RC a -> RC a -> RC a
$c- :: forall a. Num a => RC a -> RC a -> RC a
+ :: RC a -> RC a -> RC a
$c+ :: forall a. Num a => RC a -> RC a -> RC a
Haskell.Num, RC a -> RC a -> Bool
(RC a -> RC a -> Bool) -> Eq (RC a)
forall a. Eq a => RC a -> RC a -> Bool
forall a. (a -> a -> Bool) -> Eq a
== :: RC a -> RC a -> Bool
$c== :: forall a. Eq a => RC a -> RC a -> Bool
Eq, Eq (RC a)
Eq (RC a)
-> (RC a -> RC a -> Ordering)
-> (RC a -> RC a -> Bool)
-> (RC a -> RC a -> Bool)
-> (RC a -> RC a -> Bool)
-> (RC a -> RC a -> Bool)
-> (RC a -> RC a -> RC a)
-> (RC a -> RC a -> RC a)
-> Ord (RC a)
RC a -> RC a -> Bool
RC a -> RC a -> Ordering
RC a -> RC a -> RC a
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
forall a. Ord a => Eq (RC a)
forall a. Ord a => RC a -> RC a -> Bool
forall a. Ord a => RC a -> RC a -> Ordering
forall a. Ord a => RC a -> RC a -> RC a
min :: RC a -> RC a -> RC a
$cmin :: forall a. Ord a => RC a -> RC a -> RC a
max :: RC a -> RC a -> RC a
$cmax :: forall a. Ord a => RC a -> RC a -> RC a
>= :: RC a -> RC a -> Bool
$c>= :: forall a. Ord a => RC a -> RC a -> Bool
> :: RC a -> RC a -> Bool
$c> :: forall a. Ord a => RC a -> RC a -> Bool
<= :: RC a -> RC a -> Bool
$c<= :: forall a. Ord a => RC a -> RC a -> Bool
< :: RC a -> RC a -> Bool
$c< :: forall a. Ord a => RC a -> RC a -> Bool
compare :: RC a -> RC a -> Ordering
$ccompare :: forall a. Ord a => RC a -> RC a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (RC a)
Ord, AdditiveMonoid (RC a)
AdditiveMonoid (RC a)
-> (RC a -> RC a -> RC a) -> AdditiveGroup (RC a)
RC a -> RC a -> RC a
forall a. AdditiveGroup a => AdditiveMonoid (RC a)
forall a. AdditiveGroup a => RC a -> RC a -> RC a
forall a. AdditiveMonoid a -> (a -> a -> a) -> AdditiveGroup a
- :: RC a -> RC a -> RC a
$c- :: forall a. AdditiveGroup a => RC a -> RC a -> RC a
$cp1AdditiveGroup :: forall a. AdditiveGroup a => AdditiveMonoid (RC a)
AdditiveGroup, AdditiveSemigroup (RC a)
RC a
AdditiveSemigroup (RC a) -> RC a -> AdditiveMonoid (RC a)
forall a. AdditiveMonoid a => AdditiveSemigroup (RC a)
forall a. AdditiveMonoid a => RC a
forall a. AdditiveSemigroup a -> a -> AdditiveMonoid a
zero :: RC a
$czero :: forall a. AdditiveMonoid a => RC a
$cp1AdditiveMonoid :: forall a. AdditiveMonoid a => AdditiveSemigroup (RC a)
AdditiveMonoid, RC a -> RC a -> RC a
(RC a -> RC a -> RC a) -> AdditiveSemigroup (RC a)
forall a. AdditiveSemigroup a => RC a -> RC a -> RC a
forall a. (a -> a -> a) -> AdditiveSemigroup a
+ :: RC a -> RC a -> RC a
$c+ :: forall a. AdditiveSemigroup a => RC a -> RC a -> RC a
AdditiveSemigroup, RC a -> RC a -> RC a
(RC a -> RC a -> RC a) -> MultiplicativeSemigroup (RC a)
forall a. MultiplicativeSemigroup a => RC a -> RC a -> RC a
forall a. (a -> a -> a) -> MultiplicativeSemigroup a
* :: RC a -> RC a -> RC a
$c* :: forall a. MultiplicativeSemigroup a => RC a -> RC a -> RC a
MultiplicativeSemigroup)
deriving stock ((forall x. RC a -> Rep (RC a) x)
-> (forall x. Rep (RC a) x -> RC a) -> Generic (RC a)
forall x. Rep (RC a) x -> RC a
forall x. RC a -> Rep (RC a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RC a) x -> RC a
forall a x. RC a -> Rep (RC a) x
$cto :: forall a x. Rep (RC a) x -> RC a
$cfrom :: forall a x. RC a -> Rep (RC a) x
Generic, RC a -> RC a -> Bool
(RC a -> RC a -> Bool) -> (RC a -> RC a -> Bool) -> Eq (RC a)
forall a. Eq a => RC a -> RC a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RC a -> RC a -> Bool
$c/= :: forall a. Eq a => RC a -> RC a -> Bool
== :: RC a -> RC a -> Bool
$c== :: forall a. Eq a => RC a -> RC a -> Bool
Haskell.Eq, Int -> RC a -> ShowS
[RC a] -> ShowS
RC a -> String
(Int -> RC a -> ShowS)
-> (RC a -> String) -> ([RC a] -> ShowS) -> Show (RC a)
forall a. Show a => Int -> RC a -> ShowS
forall a. Show a => [RC a] -> ShowS
forall a. Show a => RC a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RC a] -> ShowS
$cshowList :: forall a. Show a => [RC a] -> ShowS
show :: RC a -> String
$cshow :: forall a. Show a => RC a -> String
showsPrec :: Int -> RC a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RC a -> ShowS
Haskell.Show)
deriving anyclass ([RC a] -> Encoding
[RC a] -> Value
RC a -> Encoding
RC a -> Value
(RC a -> Value)
-> (RC a -> Encoding)
-> ([RC a] -> Value)
-> ([RC a] -> Encoding)
-> ToJSON (RC a)
forall a. ToJSON a => [RC a] -> Encoding
forall a. ToJSON a => [RC a] -> Value
forall a. ToJSON a => RC a -> Encoding
forall a. ToJSON a => RC a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RC a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [RC a] -> Encoding
toJSONList :: [RC a] -> Value
$ctoJSONList :: forall a. ToJSON a => [RC a] -> Value
toEncoding :: RC a -> Encoding
$ctoEncoding :: forall a. ToJSON a => RC a -> Encoding
toJSON :: RC a -> Value
$ctoJSON :: forall a. ToJSON a => RC a -> Value
ToJSON, Value -> Parser [RC a]
Value -> Parser (RC a)
(Value -> Parser (RC a))
-> (Value -> Parser [RC a]) -> FromJSON (RC a)
forall a. FromJSON a => Value -> Parser [RC a]
forall a. FromJSON a => Value -> Parser (RC a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RC a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [RC a]
parseJSON :: Value -> Parser (RC a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (RC a)
FromJSON)
deriving (a -> b) -> RC a -> RC b
(forall a b. (a -> b) -> RC a -> RC b) -> Functor RC
forall a b. (a -> b) -> RC a -> RC b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b) -> Functor f
fmap :: (a -> b) -> RC a -> RC b
$cfmap :: forall a b. (a -> b) -> RC a -> RC b
Functor via Identity
newtype BC a = BC { BC a -> a
unBC :: a }
deriving newtype (Integer -> BC a
BC a -> BC a
BC a -> BC a -> BC a
(BC a -> BC a -> BC a)
-> (BC a -> BC a -> BC a)
-> (BC a -> BC a -> BC a)
-> (BC a -> BC a)
-> (BC a -> BC a)
-> (BC a -> BC a)
-> (Integer -> BC a)
-> Num (BC a)
forall a. Num a => Integer -> BC a
forall a. Num a => BC a -> BC a
forall a. Num a => BC a -> BC a -> BC a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BC a
$cfromInteger :: forall a. Num a => Integer -> BC a
signum :: BC a -> BC a
$csignum :: forall a. Num a => BC a -> BC a
abs :: BC a -> BC a
$cabs :: forall a. Num a => BC a -> BC a
negate :: BC a -> BC a
$cnegate :: forall a. Num a => BC a -> BC a
* :: BC a -> BC a -> BC a
$c* :: forall a. Num a => BC a -> BC a -> BC a
- :: BC a -> BC a -> BC a
$c- :: forall a. Num a => BC a -> BC a -> BC a
+ :: BC a -> BC a -> BC a
$c+ :: forall a. Num a => BC a -> BC a -> BC a
Haskell.Num, BC a -> BC a -> Bool
(BC a -> BC a -> Bool) -> Eq (BC a)
forall a. Eq a => BC a -> BC a -> Bool
forall a. (a -> a -> Bool) -> Eq a
== :: BC a -> BC a -> Bool
$c== :: forall a. Eq a => BC a -> BC a -> Bool
Eq, Eq (BC a)
Eq (BC a)
-> (BC a -> BC a -> Ordering)
-> (BC a -> BC a -> Bool)
-> (BC a -> BC a -> Bool)
-> (BC a -> BC a -> Bool)
-> (BC a -> BC a -> Bool)
-> (BC a -> BC a -> BC a)
-> (BC a -> BC a -> BC a)
-> Ord (BC a)
BC a -> BC a -> Bool
BC a -> BC a -> Ordering
BC a -> BC a -> BC a
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
forall a. Ord a => Eq (BC a)
forall a. Ord a => BC a -> BC a -> Bool
forall a. Ord a => BC a -> BC a -> Ordering
forall a. Ord a => BC a -> BC a -> BC a
min :: BC a -> BC a -> BC a
$cmin :: forall a. Ord a => BC a -> BC a -> BC a
max :: BC a -> BC a -> BC a
$cmax :: forall a. Ord a => BC a -> BC a -> BC a
>= :: BC a -> BC a -> Bool
$c>= :: forall a. Ord a => BC a -> BC a -> Bool
> :: BC a -> BC a -> Bool
$c> :: forall a. Ord a => BC a -> BC a -> Bool
<= :: BC a -> BC a -> Bool
$c<= :: forall a. Ord a => BC a -> BC a -> Bool
< :: BC a -> BC a -> Bool
$c< :: forall a. Ord a => BC a -> BC a -> Bool
compare :: BC a -> BC a -> Ordering
$ccompare :: forall a. Ord a => BC a -> BC a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (BC a)
Ord, AdditiveMonoid (BC a)
AdditiveMonoid (BC a)
-> (BC a -> BC a -> BC a) -> AdditiveGroup (BC a)
BC a -> BC a -> BC a
forall a. AdditiveGroup a => AdditiveMonoid (BC a)
forall a. AdditiveGroup a => BC a -> BC a -> BC a
forall a. AdditiveMonoid a -> (a -> a -> a) -> AdditiveGroup a
- :: BC a -> BC a -> BC a
$c- :: forall a. AdditiveGroup a => BC a -> BC a -> BC a
$cp1AdditiveGroup :: forall a. AdditiveGroup a => AdditiveMonoid (BC a)
AdditiveGroup, AdditiveSemigroup (BC a)
BC a
AdditiveSemigroup (BC a) -> BC a -> AdditiveMonoid (BC a)
forall a. AdditiveMonoid a => AdditiveSemigroup (BC a)
forall a. AdditiveMonoid a => BC a
forall a. AdditiveSemigroup a -> a -> AdditiveMonoid a
zero :: BC a
$czero :: forall a. AdditiveMonoid a => BC a
$cp1AdditiveMonoid :: forall a. AdditiveMonoid a => AdditiveSemigroup (BC a)
AdditiveMonoid, BC a -> BC a -> BC a
(BC a -> BC a -> BC a) -> AdditiveSemigroup (BC a)
forall a. AdditiveSemigroup a => BC a -> BC a -> BC a
forall a. (a -> a -> a) -> AdditiveSemigroup a
+ :: BC a -> BC a -> BC a
$c+ :: forall a. AdditiveSemigroup a => BC a -> BC a -> BC a
AdditiveSemigroup, BC a -> BC a -> BC a
(BC a -> BC a -> BC a) -> MultiplicativeSemigroup (BC a)
forall a. MultiplicativeSemigroup a => BC a -> BC a -> BC a
forall a. (a -> a -> a) -> MultiplicativeSemigroup a
* :: BC a -> BC a -> BC a
$c* :: forall a. MultiplicativeSemigroup a => BC a -> BC a -> BC a
MultiplicativeSemigroup)
deriving stock ((forall x. BC a -> Rep (BC a) x)
-> (forall x. Rep (BC a) x -> BC a) -> Generic (BC a)
forall x. Rep (BC a) x -> BC a
forall x. BC a -> Rep (BC a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (BC a) x -> BC a
forall a x. BC a -> Rep (BC a) x
$cto :: forall a x. Rep (BC a) x -> BC a
$cfrom :: forall a x. BC a -> Rep (BC a) x
Generic, BC a -> BC a -> Bool
(BC a -> BC a -> Bool) -> (BC a -> BC a -> Bool) -> Eq (BC a)
forall a. Eq a => BC a -> BC a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BC a -> BC a -> Bool
$c/= :: forall a. Eq a => BC a -> BC a -> Bool
== :: BC a -> BC a -> Bool
$c== :: forall a. Eq a => BC a -> BC a -> Bool
Haskell.Eq, Int -> BC a -> ShowS
[BC a] -> ShowS
BC a -> String
(Int -> BC a -> ShowS)
-> (BC a -> String) -> ([BC a] -> ShowS) -> Show (BC a)
forall a. Show a => Int -> BC a -> ShowS
forall a. Show a => [BC a] -> ShowS
forall a. Show a => BC a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BC a] -> ShowS
$cshowList :: forall a. Show a => [BC a] -> ShowS
show :: BC a -> String
$cshow :: forall a. Show a => BC a -> String
showsPrec :: Int -> BC a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> BC a -> ShowS
Haskell.Show)
deriving anyclass ([BC a] -> Encoding
[BC a] -> Value
BC a -> Encoding
BC a -> Value
(BC a -> Value)
-> (BC a -> Encoding)
-> ([BC a] -> Value)
-> ([BC a] -> Encoding)
-> ToJSON (BC a)
forall a. ToJSON a => [BC a] -> Encoding
forall a. ToJSON a => [BC a] -> Value
forall a. ToJSON a => BC a -> Encoding
forall a. ToJSON a => BC a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BC a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [BC a] -> Encoding
toJSONList :: [BC a] -> Value
$ctoJSONList :: forall a. ToJSON a => [BC a] -> Value
toEncoding :: BC a -> Encoding
$ctoEncoding :: forall a. ToJSON a => BC a -> Encoding
toJSON :: BC a -> Value
$ctoJSON :: forall a. ToJSON a => BC a -> Value
ToJSON, Value -> Parser [BC a]
Value -> Parser (BC a)
(Value -> Parser (BC a))
-> (Value -> Parser [BC a]) -> FromJSON (BC a)
forall a. FromJSON a => Value -> Parser [BC a]
forall a. FromJSON a => Value -> Parser (BC a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BC a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [BC a]
parseJSON :: Value -> Parser (BC a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (BC a)
FromJSON)
deriving (a -> b) -> BC a -> BC b
(forall a b. (a -> b) -> BC a -> BC b) -> Functor BC
forall a b. (a -> b) -> BC a -> BC b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b) -> Functor f
fmap :: (a -> b) -> BC a -> BC b
$cfmap :: forall a b. (a -> b) -> BC a -> BC b
Functor via Identity
newtype PC a = PC { PC a -> a
unPC :: a }
deriving newtype (Integer -> PC a
PC a -> PC a
PC a -> PC a -> PC a
(PC a -> PC a -> PC a)
-> (PC a -> PC a -> PC a)
-> (PC a -> PC a -> PC a)
-> (PC a -> PC a)
-> (PC a -> PC a)
-> (PC a -> PC a)
-> (Integer -> PC a)
-> Num (PC a)
forall a. Num a => Integer -> PC a
forall a. Num a => PC a -> PC a
forall a. Num a => PC a -> PC a -> PC a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> PC a
$cfromInteger :: forall a. Num a => Integer -> PC a
signum :: PC a -> PC a
$csignum :: forall a. Num a => PC a -> PC a
abs :: PC a -> PC a
$cabs :: forall a. Num a => PC a -> PC a
negate :: PC a -> PC a
$cnegate :: forall a. Num a => PC a -> PC a
* :: PC a -> PC a -> PC a
$c* :: forall a. Num a => PC a -> PC a -> PC a
- :: PC a -> PC a -> PC a
$c- :: forall a. Num a => PC a -> PC a -> PC a
+ :: PC a -> PC a -> PC a
$c+ :: forall a. Num a => PC a -> PC a -> PC a
Haskell.Num, PC a -> PC a -> Bool
(PC a -> PC a -> Bool) -> Eq (PC a)
forall a. Eq a => PC a -> PC a -> Bool
forall a. (a -> a -> Bool) -> Eq a
== :: PC a -> PC a -> Bool
$c== :: forall a. Eq a => PC a -> PC a -> Bool
Eq, Eq (PC a)
Eq (PC a)
-> (PC a -> PC a -> Ordering)
-> (PC a -> PC a -> Bool)
-> (PC a -> PC a -> Bool)
-> (PC a -> PC a -> Bool)
-> (PC a -> PC a -> Bool)
-> (PC a -> PC a -> PC a)
-> (PC a -> PC a -> PC a)
-> Ord (PC a)
PC a -> PC a -> Bool
PC a -> PC a -> Ordering
PC a -> PC a -> PC a
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
forall a. Ord a => Eq (PC a)
forall a. Ord a => PC a -> PC a -> Bool
forall a. Ord a => PC a -> PC a -> Ordering
forall a. Ord a => PC a -> PC a -> PC a
min :: PC a -> PC a -> PC a
$cmin :: forall a. Ord a => PC a -> PC a -> PC a
max :: PC a -> PC a -> PC a
$cmax :: forall a. Ord a => PC a -> PC a -> PC a
>= :: PC a -> PC a -> Bool
$c>= :: forall a. Ord a => PC a -> PC a -> Bool
> :: PC a -> PC a -> Bool
$c> :: forall a. Ord a => PC a -> PC a -> Bool
<= :: PC a -> PC a -> Bool
$c<= :: forall a. Ord a => PC a -> PC a -> Bool
< :: PC a -> PC a -> Bool
$c< :: forall a. Ord a => PC a -> PC a -> Bool
compare :: PC a -> PC a -> Ordering
$ccompare :: forall a. Ord a => PC a -> PC a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (PC a)
Ord, AdditiveMonoid (PC a)
AdditiveMonoid (PC a)
-> (PC a -> PC a -> PC a) -> AdditiveGroup (PC a)
PC a -> PC a -> PC a
forall a. AdditiveGroup a => AdditiveMonoid (PC a)
forall a. AdditiveGroup a => PC a -> PC a -> PC a
forall a. AdditiveMonoid a -> (a -> a -> a) -> AdditiveGroup a
- :: PC a -> PC a -> PC a
$c- :: forall a. AdditiveGroup a => PC a -> PC a -> PC a
$cp1AdditiveGroup :: forall a. AdditiveGroup a => AdditiveMonoid (PC a)
AdditiveGroup, AdditiveSemigroup (PC a)
PC a
AdditiveSemigroup (PC a) -> PC a -> AdditiveMonoid (PC a)
forall a. AdditiveMonoid a => AdditiveSemigroup (PC a)
forall a. AdditiveMonoid a => PC a
forall a. AdditiveSemigroup a -> a -> AdditiveMonoid a
zero :: PC a
$czero :: forall a. AdditiveMonoid a => PC a
$cp1AdditiveMonoid :: forall a. AdditiveMonoid a => AdditiveSemigroup (PC a)
AdditiveMonoid, PC a -> PC a -> PC a
(PC a -> PC a -> PC a) -> AdditiveSemigroup (PC a)
forall a. AdditiveSemigroup a => PC a -> PC a -> PC a
forall a. (a -> a -> a) -> AdditiveSemigroup a
+ :: PC a -> PC a -> PC a
$c+ :: forall a. AdditiveSemigroup a => PC a -> PC a -> PC a
AdditiveSemigroup, PC a -> PC a -> PC a
(PC a -> PC a -> PC a) -> MultiplicativeSemigroup (PC a)
forall a. MultiplicativeSemigroup a => PC a -> PC a -> PC a
forall a. (a -> a -> a) -> MultiplicativeSemigroup a
* :: PC a -> PC a -> PC a
$c* :: forall a. MultiplicativeSemigroup a => PC a -> PC a -> PC a
MultiplicativeSemigroup)
deriving stock ((forall x. PC a -> Rep (PC a) x)
-> (forall x. Rep (PC a) x -> PC a) -> Generic (PC a)
forall x. Rep (PC a) x -> PC a
forall x. PC a -> Rep (PC a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (PC a) x -> PC a
forall a x. PC a -> Rep (PC a) x
$cto :: forall a x. Rep (PC a) x -> PC a
$cfrom :: forall a x. PC a -> Rep (PC a) x
Generic, PC a -> PC a -> Bool
(PC a -> PC a -> Bool) -> (PC a -> PC a -> Bool) -> Eq (PC a)
forall a. Eq a => PC a -> PC a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PC a -> PC a -> Bool
$c/= :: forall a. Eq a => PC a -> PC a -> Bool
== :: PC a -> PC a -> Bool
$c== :: forall a. Eq a => PC a -> PC a -> Bool
Haskell.Eq, Int -> PC a -> ShowS
[PC a] -> ShowS
PC a -> String
(Int -> PC a -> ShowS)
-> (PC a -> String) -> ([PC a] -> ShowS) -> Show (PC a)
forall a. Show a => Int -> PC a -> ShowS
forall a. Show a => [PC a] -> ShowS
forall a. Show a => PC a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PC a] -> ShowS
$cshowList :: forall a. Show a => [PC a] -> ShowS
show :: PC a -> String
$cshow :: forall a. Show a => PC a -> String
showsPrec :: Int -> PC a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> PC a -> ShowS
Haskell.Show)
deriving anyclass ([PC a] -> Encoding
[PC a] -> Value
PC a -> Encoding
PC a -> Value
(PC a -> Value)
-> (PC a -> Encoding)
-> ([PC a] -> Value)
-> ([PC a] -> Encoding)
-> ToJSON (PC a)
forall a. ToJSON a => [PC a] -> Encoding
forall a. ToJSON a => [PC a] -> Value
forall a. ToJSON a => PC a -> Encoding
forall a. ToJSON a => PC a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PC a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [PC a] -> Encoding
toJSONList :: [PC a] -> Value
$ctoJSONList :: forall a. ToJSON a => [PC a] -> Value
toEncoding :: PC a -> Encoding
$ctoEncoding :: forall a. ToJSON a => PC a -> Encoding
toJSON :: PC a -> Value
$ctoJSON :: forall a. ToJSON a => PC a -> Value
ToJSON, Value -> Parser [PC a]
Value -> Parser (PC a)
(Value -> Parser (PC a))
-> (Value -> Parser [PC a]) -> FromJSON (PC a)
forall a. FromJSON a => Value -> Parser [PC a]
forall a. FromJSON a => Value -> Parser (PC a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PC a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [PC a]
parseJSON :: Value -> Parser (PC a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (PC a)
FromJSON)
deriving (a -> b) -> PC a -> PC b
(forall a b. (a -> b) -> PC a -> PC b) -> Functor PC
forall a b. (a -> b) -> PC a -> PC b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b) -> Functor f
fmap :: (a -> b) -> PC a -> PC b
$cfmap :: forall a b. (a -> b) -> PC a -> PC b
Functor via Identity
data BankState =
BankState
{ BankState -> BC Integer
bsReserves :: BC Integer
, BankState -> SC Integer
bsStablecoins :: SC Integer
, BankState -> RC Integer
bsReservecoins :: RC Integer
, BankState -> MintingPolicyHash
bsMintingPolicyScript :: MintingPolicyHash
}
deriving stock ((forall x. BankState -> Rep BankState x)
-> (forall x. Rep BankState x -> BankState) -> Generic BankState
forall x. Rep BankState x -> BankState
forall x. BankState -> Rep BankState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BankState x -> BankState
$cfrom :: forall x. BankState -> Rep BankState x
Generic, BankState -> BankState -> Bool
(BankState -> BankState -> Bool)
-> (BankState -> BankState -> Bool) -> Eq BankState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BankState -> BankState -> Bool
$c/= :: BankState -> BankState -> Bool
== :: BankState -> BankState -> Bool
$c== :: BankState -> BankState -> Bool
Haskell.Eq, Int -> BankState -> ShowS
[BankState] -> ShowS
BankState -> String
(Int -> BankState -> ShowS)
-> (BankState -> String)
-> ([BankState] -> ShowS)
-> Show BankState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BankState] -> ShowS
$cshowList :: [BankState] -> ShowS
show :: BankState -> String
$cshow :: BankState -> String
showsPrec :: Int -> BankState -> ShowS
$cshowsPrec :: Int -> BankState -> ShowS
Haskell.Show)
deriving anyclass ([BankState] -> Encoding
[BankState] -> Value
BankState -> Encoding
BankState -> Value
(BankState -> Value)
-> (BankState -> Encoding)
-> ([BankState] -> Value)
-> ([BankState] -> Encoding)
-> ToJSON BankState
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BankState] -> Encoding
$ctoEncodingList :: [BankState] -> Encoding
toJSONList :: [BankState] -> Value
$ctoJSONList :: [BankState] -> Value
toEncoding :: BankState -> Encoding
$ctoEncoding :: BankState -> Encoding
toJSON :: BankState -> Value
$ctoJSON :: BankState -> Value
ToJSON, Value -> Parser [BankState]
Value -> Parser BankState
(Value -> Parser BankState)
-> (Value -> Parser [BankState]) -> FromJSON BankState
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BankState]
$cparseJSONList :: Value -> Parser [BankState]
parseJSON :: Value -> Parser BankState
$cparseJSON :: Value -> Parser BankState
FromJSON)
initialState :: StateMachineClient BankState Input -> BankState
initialState :: StateMachineClient BankState Input -> BankState
initialState StateMachineClient{scInstance :: forall s i. StateMachineClient s i -> StateMachineInstance s i
scInstance=SM.StateMachineInstance{TypedValidator (StateMachine BankState Input)
typedValidator :: forall s i.
StateMachineInstance s i -> TypedValidator (StateMachine s i)
typedValidator :: TypedValidator (StateMachine BankState Input)
SM.typedValidator}} =
BankState :: BC Integer
-> SC Integer -> RC Integer -> MintingPolicyHash -> BankState
BankState
{ bsReserves :: BC Integer
bsReserves = BC Integer
0
, bsStablecoins :: SC Integer
bsStablecoins = SC Integer
0
, bsReservecoins :: RC Integer
bsReservecoins = RC Integer
0
, bsMintingPolicyScript :: MintingPolicyHash
bsMintingPolicyScript = TypedValidator (StateMachine BankState Input) -> MintingPolicyHash
forall a. TypedValidator a -> MintingPolicyHash
V2.forwardingMintingPolicyHash TypedValidator (StateMachine BankState Input)
typedValidator
}
{-# INLINEABLE convert #-}
convert :: ConversionRate -> PC Rational -> BC Rational
convert :: ConversionRate -> PC ConversionRate -> BC ConversionRate
convert ConversionRate
rate (PC ConversionRate
pc) =
ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (ConversionRate -> BC ConversionRate)
-> ConversionRate -> BC ConversionRate
forall a b. (a -> b) -> a -> b
$ ConversionRate
rate ConversionRate -> ConversionRate -> ConversionRate
forall a. MultiplicativeSemigroup a => a -> a -> a
* ConversionRate
pc
{-# INLINEABLE liabilities #-}
liabilities ::
BankState
-> ConversionRate
-> BC Rational
liabilities :: BankState -> ConversionRate -> BC ConversionRate
liabilities BankState{bsReserves :: BankState -> BC Integer
bsReserves=BC Integer
reserves,bsStablecoins :: BankState -> SC Integer
bsStablecoins=SC Integer
stablecoins} ConversionRate
cr =
let BC ConversionRate
stableCoinLiabilities = ConversionRate -> PC ConversionRate -> BC ConversionRate
convert ConversionRate
cr (ConversionRate -> PC ConversionRate
forall a. a -> PC a
PC (ConversionRate -> PC ConversionRate)
-> ConversionRate -> PC ConversionRate
forall a b. (a -> b) -> a -> b
$ Integer -> ConversionRate
fromInteger Integer
stablecoins)
in ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (ConversionRate -> ConversionRate -> ConversionRate
forall a. Ord a => a -> a -> a
min (Integer -> ConversionRate
fromInteger Integer
reserves) ConversionRate
stableCoinLiabilities)
{-# INLINEABLE equity #-}
equity ::
BankState
-> ConversionRate
-> BC Rational
equity :: BankState -> ConversionRate -> BC ConversionRate
equity r :: BankState
r@BankState{bsReserves :: BankState -> BC Integer
bsReserves=BC Integer
reserves} ConversionRate
cr =
let BC ConversionRate
l = BankState -> ConversionRate -> BC ConversionRate
liabilities BankState
r ConversionRate
cr
in ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (Integer -> ConversionRate
fromInteger Integer
reserves ConversionRate -> ConversionRate -> ConversionRate
forall a. AdditiveGroup a => a -> a -> a
- ConversionRate
l)
data Stablecoin =
Stablecoin
{ Stablecoin -> PaymentPubKey
scOracle :: PaymentPubKey
, Stablecoin -> ConversionRate
scFee :: Rational
, Stablecoin -> ConversionRate
scMinReserveRatio :: Rational
, Stablecoin -> ConversionRate
scMaxReserveRatio :: Rational
, Stablecoin -> BC Integer
scReservecoinDefaultPrice :: BC Integer
, Stablecoin -> AssetClass
scBaseCurrency :: AssetClass
, Stablecoin -> TokenName
scStablecoinTokenName :: TokenName
, Stablecoin -> TokenName
scReservecoinTokenName :: TokenName
}
deriving stock ((forall x. Stablecoin -> Rep Stablecoin x)
-> (forall x. Rep Stablecoin x -> Stablecoin) -> Generic Stablecoin
forall x. Rep Stablecoin x -> Stablecoin
forall x. Stablecoin -> Rep Stablecoin x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Stablecoin x -> Stablecoin
$cfrom :: forall x. Stablecoin -> Rep Stablecoin x
Generic, Stablecoin -> Stablecoin -> Bool
(Stablecoin -> Stablecoin -> Bool)
-> (Stablecoin -> Stablecoin -> Bool) -> Eq Stablecoin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stablecoin -> Stablecoin -> Bool
$c/= :: Stablecoin -> Stablecoin -> Bool
== :: Stablecoin -> Stablecoin -> Bool
$c== :: Stablecoin -> Stablecoin -> Bool
Haskell.Eq, Int -> Stablecoin -> ShowS
[Stablecoin] -> ShowS
Stablecoin -> String
(Int -> Stablecoin -> ShowS)
-> (Stablecoin -> String)
-> ([Stablecoin] -> ShowS)
-> Show Stablecoin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Stablecoin] -> ShowS
$cshowList :: [Stablecoin] -> ShowS
show :: Stablecoin -> String
$cshow :: Stablecoin -> String
showsPrec :: Int -> Stablecoin -> ShowS
$cshowsPrec :: Int -> Stablecoin -> ShowS
Haskell.Show)
deriving anyclass ([Stablecoin] -> Encoding
[Stablecoin] -> Value
Stablecoin -> Encoding
Stablecoin -> Value
(Stablecoin -> Value)
-> (Stablecoin -> Encoding)
-> ([Stablecoin] -> Value)
-> ([Stablecoin] -> Encoding)
-> ToJSON Stablecoin
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Stablecoin] -> Encoding
$ctoEncodingList :: [Stablecoin] -> Encoding
toJSONList :: [Stablecoin] -> Value
$ctoJSONList :: [Stablecoin] -> Value
toEncoding :: Stablecoin -> Encoding
$ctoEncoding :: Stablecoin -> Encoding
toJSON :: Stablecoin -> Value
$ctoJSON :: Stablecoin -> Value
ToJSON, Value -> Parser [Stablecoin]
Value -> Parser Stablecoin
(Value -> Parser Stablecoin)
-> (Value -> Parser [Stablecoin]) -> FromJSON Stablecoin
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Stablecoin]
$cparseJSONList :: Value -> Parser [Stablecoin]
parseJSON :: Value -> Parser Stablecoin
$cparseJSON :: Value -> Parser Stablecoin
FromJSON)
{-# INLINEABLE minReserve #-}
minReserve :: Stablecoin -> ConversionRate -> BankState -> Maybe (BC Rational)
minReserve :: Stablecoin
-> ConversionRate -> BankState -> Maybe (BC ConversionRate)
minReserve Stablecoin{ConversionRate
scMinReserveRatio :: ConversionRate
scMinReserveRatio :: Stablecoin -> ConversionRate
scMinReserveRatio} ConversionRate
cr BankState{bsStablecoins :: BankState -> SC Integer
bsStablecoins=SC Integer
sc}
| Integer
sc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
forall a. AdditiveMonoid a => a
zero = Maybe (BC ConversionRate)
forall a. Maybe a
Nothing
| Bool
otherwise =
let BC ConversionRate
r = ConversionRate -> PC ConversionRate -> BC ConversionRate
convert ConversionRate
cr (ConversionRate -> PC ConversionRate
forall a. a -> PC a
PC (ConversionRate -> PC ConversionRate)
-> ConversionRate -> PC ConversionRate
forall a b. (a -> b) -> a -> b
$ Integer -> ConversionRate
fromInteger Integer
sc)
in BC ConversionRate -> Maybe (BC ConversionRate)
forall a. a -> Maybe a
Just (BC ConversionRate -> Maybe (BC ConversionRate))
-> BC ConversionRate -> Maybe (BC ConversionRate)
forall a b. (a -> b) -> a -> b
$ ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (ConversionRate -> BC ConversionRate)
-> ConversionRate -> BC ConversionRate
forall a b. (a -> b) -> a -> b
$ ConversionRate
scMinReserveRatio ConversionRate -> ConversionRate -> ConversionRate
forall a. MultiplicativeSemigroup a => a -> a -> a
* ConversionRate
r
{-# INLINEABLE maxReserve #-}
maxReserve :: Stablecoin -> ConversionRate -> BankState -> Maybe (BC Rational)
maxReserve :: Stablecoin
-> ConversionRate -> BankState -> Maybe (BC ConversionRate)
maxReserve Stablecoin{ConversionRate
scMaxReserveRatio :: ConversionRate
scMaxReserveRatio :: Stablecoin -> ConversionRate
scMaxReserveRatio} ConversionRate
cr BankState{bsStablecoins :: BankState -> SC Integer
bsStablecoins=SC Integer
sc}
| Integer
sc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
forall a. AdditiveMonoid a => a
zero = Maybe (BC ConversionRate)
forall a. Maybe a
Nothing
| Bool
otherwise =
let BC ConversionRate
r = ConversionRate -> PC ConversionRate -> BC ConversionRate
convert ConversionRate
cr (ConversionRate -> PC ConversionRate
forall a. a -> PC a
PC (ConversionRate -> PC ConversionRate)
-> ConversionRate -> PC ConversionRate
forall a b. (a -> b) -> a -> b
$ Integer -> ConversionRate
fromInteger Integer
sc)
in BC ConversionRate -> Maybe (BC ConversionRate)
forall a. a -> Maybe a
Just (BC ConversionRate -> Maybe (BC ConversionRate))
-> BC ConversionRate -> Maybe (BC ConversionRate)
forall a b. (a -> b) -> a -> b
$ ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (ConversionRate -> BC ConversionRate)
-> ConversionRate -> BC ConversionRate
forall a b. (a -> b) -> a -> b
$ ConversionRate
scMaxReserveRatio ConversionRate -> ConversionRate -> ConversionRate
forall a. MultiplicativeSemigroup a => a -> a -> a
* ConversionRate
r
{-# INLINEABLE reservecoinNominalPrice #-}
reservecoinNominalPrice :: Stablecoin -> BankState -> ConversionRate -> BC Rational
reservecoinNominalPrice :: Stablecoin -> BankState -> ConversionRate -> BC ConversionRate
reservecoinNominalPrice Stablecoin{BC Integer
scReservecoinDefaultPrice :: BC Integer
scReservecoinDefaultPrice :: Stablecoin -> BC Integer
scReservecoinDefaultPrice} bankState :: BankState
bankState@BankState{bsReservecoins :: BankState -> RC Integer
bsReservecoins=RC Integer
rc} ConversionRate
cr
| Integer
rc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 = let BC ConversionRate
e = BankState -> ConversionRate -> BC ConversionRate
equity BankState
bankState ConversionRate
cr in ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (ConversionRate
e ConversionRate -> ConversionRate -> ConversionRate
forall a. MultiplicativeSemigroup a => a -> a -> a
* ConversionRate -> ConversionRate
R.recip (Integer -> ConversionRate
fromInteger Integer
rc))
| Bool
otherwise = (Integer -> ConversionRate) -> BC Integer -> BC ConversionRate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> ConversionRate
fromInteger BC Integer
scReservecoinDefaultPrice
{-# INLINEABLE stablecoinNominalPrice #-}
stablecoinNominalPrice :: BankState -> ConversionRate -> BC Rational
stablecoinNominalPrice :: BankState -> ConversionRate -> BC ConversionRate
stablecoinNominalPrice bankState :: BankState
bankState@BankState{bsStablecoins :: BankState -> SC Integer
bsStablecoins=SC Integer
sc} ConversionRate
cr
| Integer
sc Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
forall a. AdditiveMonoid a => a
zero = ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC ConversionRate
p
| Bool
otherwise = ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (ConversionRate -> BC ConversionRate)
-> ConversionRate -> BC ConversionRate
forall a b. (a -> b) -> a -> b
$ ConversionRate -> ConversionRate -> ConversionRate
forall a. Ord a => a -> a -> a
min ConversionRate
p ConversionRate
l
where
BC ConversionRate
p = ConversionRate -> PC ConversionRate -> BC ConversionRate
convert ConversionRate
cr (ConversionRate -> PC ConversionRate
forall a. a -> PC a
PC (ConversionRate -> PC ConversionRate)
-> ConversionRate -> PC ConversionRate
forall a b. (a -> b) -> a -> b
$ Integer -> ConversionRate
fromInteger Integer
1)
BC ConversionRate
l = BankState -> ConversionRate -> BC ConversionRate
liabilities BankState
bankState ConversionRate
cr
data SCAction
= MintStablecoin (SC Integer)
| MintReserveCoin (RC Integer)
deriving stock ((forall x. SCAction -> Rep SCAction x)
-> (forall x. Rep SCAction x -> SCAction) -> Generic SCAction
forall x. Rep SCAction x -> SCAction
forall x. SCAction -> Rep SCAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SCAction x -> SCAction
$cfrom :: forall x. SCAction -> Rep SCAction x
Generic, SCAction -> SCAction -> Bool
(SCAction -> SCAction -> Bool)
-> (SCAction -> SCAction -> Bool) -> Eq SCAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SCAction -> SCAction -> Bool
$c/= :: SCAction -> SCAction -> Bool
== :: SCAction -> SCAction -> Bool
$c== :: SCAction -> SCAction -> Bool
Haskell.Eq, Int -> SCAction -> ShowS
[SCAction] -> ShowS
SCAction -> String
(Int -> SCAction -> ShowS)
-> (SCAction -> String) -> ([SCAction] -> ShowS) -> Show SCAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SCAction] -> ShowS
$cshowList :: [SCAction] -> ShowS
show :: SCAction -> String
$cshow :: SCAction -> String
showsPrec :: Int -> SCAction -> ShowS
$cshowsPrec :: Int -> SCAction -> ShowS
Haskell.Show)
deriving anyclass ([SCAction] -> Encoding
[SCAction] -> Value
SCAction -> Encoding
SCAction -> Value
(SCAction -> Value)
-> (SCAction -> Encoding)
-> ([SCAction] -> Value)
-> ([SCAction] -> Encoding)
-> ToJSON SCAction
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SCAction] -> Encoding
$ctoEncodingList :: [SCAction] -> Encoding
toJSONList :: [SCAction] -> Value
$ctoJSONList :: [SCAction] -> Value
toEncoding :: SCAction -> Encoding
$ctoEncoding :: SCAction -> Encoding
toJSON :: SCAction -> Value
$ctoJSON :: SCAction -> Value
ToJSON, Value -> Parser [SCAction]
Value -> Parser SCAction
(Value -> Parser SCAction)
-> (Value -> Parser [SCAction]) -> FromJSON SCAction
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SCAction]
$cparseJSONList :: Value -> Parser [SCAction]
parseJSON :: Value -> Parser SCAction
$cparseJSON :: Value -> Parser SCAction
FromJSON)
{-# INLINEABLE calcFees #-}
calcFees :: Stablecoin -> BankState -> ConversionRate -> SCAction -> BC Rational
calcFees :: Stablecoin
-> BankState -> ConversionRate -> SCAction -> BC ConversionRate
calcFees sc :: Stablecoin
sc@Stablecoin{ConversionRate
scFee :: ConversionRate
scFee :: Stablecoin -> ConversionRate
scFee} BankState
bs ConversionRate
conversionRate = \case
MintStablecoin (SC Integer
i) ->
BankState -> ConversionRate -> BC ConversionRate
stablecoinNominalPrice BankState
bs ConversionRate
conversionRate BC ConversionRate -> BC ConversionRate -> BC ConversionRate
forall a. MultiplicativeSemigroup a => a -> a -> a
* ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC ConversionRate
scFee BC ConversionRate -> BC ConversionRate -> BC ConversionRate
forall a. MultiplicativeSemigroup a => a -> a -> a
* (ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (ConversionRate -> BC ConversionRate)
-> ConversionRate -> BC ConversionRate
forall a b. (a -> b) -> a -> b
$ ConversionRate -> ConversionRate
forall n. (Ord n, AdditiveGroup n) => n -> n
abs (ConversionRate -> ConversionRate)
-> ConversionRate -> ConversionRate
forall a b. (a -> b) -> a -> b
$ Integer -> ConversionRate
fromInteger Integer
i)
MintReserveCoin (RC Integer
i) ->
Stablecoin -> BankState -> ConversionRate -> BC ConversionRate
reservecoinNominalPrice Stablecoin
sc BankState
bs ConversionRate
conversionRate BC ConversionRate -> BC ConversionRate -> BC ConversionRate
forall a. MultiplicativeSemigroup a => a -> a -> a
* ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC ConversionRate
scFee BC ConversionRate -> BC ConversionRate -> BC ConversionRate
forall a. MultiplicativeSemigroup a => a -> a -> a
* (ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (ConversionRate -> BC ConversionRate)
-> ConversionRate -> BC ConversionRate
forall a b. (a -> b) -> a -> b
$ ConversionRate -> ConversionRate
forall n. (Ord n, AdditiveGroup n) => n -> n
abs (ConversionRate -> ConversionRate)
-> ConversionRate -> ConversionRate
forall a b. (a -> b) -> a -> b
$ Integer -> ConversionRate
fromInteger Integer
i)
data Input =
Input
{ Input -> SCAction
inpSCAction :: SCAction
, Input -> SignedMessage (Observation ConversionRate)
inpConversionRate :: SignedMessage (Observation ConversionRate)
}
deriving stock ((forall x. Input -> Rep Input x)
-> (forall x. Rep Input x -> Input) -> Generic Input
forall x. Rep Input x -> Input
forall x. Input -> Rep Input x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Input x -> Input
$cfrom :: forall x. Input -> Rep Input x
Generic, Input -> Input -> Bool
(Input -> Input -> Bool) -> (Input -> Input -> Bool) -> Eq Input
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Input -> Input -> Bool
$c/= :: Input -> Input -> Bool
== :: Input -> Input -> Bool
$c== :: Input -> Input -> Bool
Haskell.Eq, Int -> Input -> ShowS
[Input] -> ShowS
Input -> String
(Int -> Input -> ShowS)
-> (Input -> String) -> ([Input] -> ShowS) -> Show Input
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Input] -> ShowS
$cshowList :: [Input] -> ShowS
show :: Input -> String
$cshow :: Input -> String
showsPrec :: Int -> Input -> ShowS
$cshowsPrec :: Int -> Input -> ShowS
Haskell.Show)
deriving anyclass ([Input] -> Encoding
[Input] -> Value
Input -> Encoding
Input -> Value
(Input -> Value)
-> (Input -> Encoding)
-> ([Input] -> Value)
-> ([Input] -> Encoding)
-> ToJSON Input
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Input] -> Encoding
$ctoEncodingList :: [Input] -> Encoding
toJSONList :: [Input] -> Value
$ctoJSONList :: [Input] -> Value
toEncoding :: Input -> Encoding
$ctoEncoding :: Input -> Encoding
toJSON :: Input -> Value
$ctoJSON :: Input -> Value
ToJSON, Value -> Parser [Input]
Value -> Parser Input
(Value -> Parser Input)
-> (Value -> Parser [Input]) -> FromJSON Input
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Input]
$cparseJSONList :: Value -> Parser [Input]
parseJSON :: Value -> Parser Input
$cparseJSON :: Value -> Parser Input
FromJSON)
{-# INLINEABLE bankReservesValue #-}
bankReservesValue :: Stablecoin -> BankState -> Value
bankReservesValue :: Stablecoin -> BankState -> Value
bankReservesValue Stablecoin{AssetClass
scBaseCurrency :: AssetClass
scBaseCurrency :: Stablecoin -> AssetClass
scBaseCurrency} BankState{bsReserves :: BankState -> BC Integer
bsReserves = BC Integer
i} =
AssetClass -> Integer -> Value
Value.assetClassValue AssetClass
scBaseCurrency Integer
i
{-# INLINEABLE transition #-}
transition :: Stablecoin -> State BankState -> Input -> Maybe (TxConstraints Void Void, State BankState)
transition :: Stablecoin
-> State BankState
-> Input
-> Maybe (TxConstraints Void Void, State BankState)
transition Stablecoin
sc State{stateData :: forall s. State s -> s
stateData=BankState
oldState} Input
input =
let toSmState :: BankState -> State BankState
toSmState BankState
state = State :: forall s. s -> Value -> State s
State{stateData :: BankState
stateData=BankState
state, stateValue :: Value
stateValue=Stablecoin -> BankState -> Value
bankReservesValue Stablecoin
sc BankState
state}
in ((TxConstraints Void Void, BankState)
-> (TxConstraints Void Void, State BankState))
-> Maybe (TxConstraints Void Void, BankState)
-> Maybe (TxConstraints Void Void, State BankState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TxConstraints Void Void
constraints, BankState
newState) -> (TxConstraints Void Void
constraints, BankState -> State BankState
toSmState BankState
newState)) (Stablecoin
-> BankState -> Input -> Maybe (TxConstraints Void Void, BankState)
forall i o.
Stablecoin
-> BankState -> Input -> Maybe (TxConstraints i o, BankState)
step Stablecoin
sc BankState
oldState Input
input)
{-# INLINEABLE applyInput #-}
applyInput :: forall i o. Stablecoin -> BankState -> Input -> Maybe (TxConstraints i o, BankState)
applyInput :: Stablecoin
-> BankState -> Input -> Maybe (TxConstraints i o, BankState)
applyInput sc :: Stablecoin
sc@Stablecoin{PaymentPubKey
scOracle :: PaymentPubKey
scOracle :: Stablecoin -> PaymentPubKey
scOracle,TokenName
scStablecoinTokenName :: TokenName
scStablecoinTokenName :: Stablecoin -> TokenName
scStablecoinTokenName,TokenName
scReservecoinTokenName :: TokenName
scReservecoinTokenName :: Stablecoin -> TokenName
scReservecoinTokenName} bs :: BankState
bs@BankState{MintingPolicyHash
bsMintingPolicyScript :: MintingPolicyHash
bsMintingPolicyScript :: BankState -> MintingPolicyHash
bsMintingPolicyScript} Input{SCAction
inpSCAction :: SCAction
inpSCAction :: Input -> SCAction
inpSCAction, SignedMessage (Observation ConversionRate)
inpConversionRate :: SignedMessage (Observation ConversionRate)
inpConversionRate :: Input -> SignedMessage (Observation ConversionRate)
inpConversionRate} = do
(Observation{obsValue :: forall a. Observation a -> a
obsValue=ConversionRate
rate, POSIXTime
obsTime :: forall a. Observation a -> POSIXTime
obsTime :: POSIXTime
obsTime}, TxConstraints i o
constraints) <- (SignedMessageCheckError
-> Maybe (Observation ConversionRate, TxConstraints i o))
-> ((Observation ConversionRate, TxConstraints i o)
-> Maybe (Observation ConversionRate, TxConstraints i o))
-> Either
SignedMessageCheckError
(Observation ConversionRate, TxConstraints i o)
-> Maybe (Observation ConversionRate, TxConstraints i o)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Observation ConversionRate, TxConstraints i o)
-> SignedMessageCheckError
-> Maybe (Observation ConversionRate, TxConstraints i o)
forall a b. a -> b -> a
const Maybe (Observation ConversionRate, TxConstraints i o)
forall a. Maybe a
Nothing) (Observation ConversionRate, TxConstraints i o)
-> Maybe (Observation ConversionRate, TxConstraints i o)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PaymentPubKey
-> SignedMessage (Observation ConversionRate)
-> Either
SignedMessageCheckError
(Observation ConversionRate, TxConstraints i o)
forall a i o.
FromData a =>
PaymentPubKey
-> SignedMessage a
-> Either SignedMessageCheckError (a, TxConstraints i o)
verifySignedMessageConstraints PaymentPubKey
scOracle SignedMessage (Observation ConversionRate)
inpConversionRate)
let fees :: BC ConversionRate
fees = Stablecoin
-> BankState -> ConversionRate -> SCAction -> BC ConversionRate
calcFees Stablecoin
sc BankState
bs ConversionRate
rate SCAction
inpSCAction
(BankState
newState, TxConstraints i o
newConstraints) = case SCAction
inpSCAction of
MintStablecoin SC Integer
sc' ->
let scValue :: BC ConversionRate
scValue = BankState -> ConversionRate -> BC ConversionRate
stablecoinNominalPrice BankState
bs ConversionRate
rate BC ConversionRate -> BC ConversionRate -> BC ConversionRate
forall a. MultiplicativeSemigroup a => a -> a -> a
* (ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (ConversionRate -> BC ConversionRate)
-> ConversionRate -> BC ConversionRate
forall a b. (a -> b) -> a -> b
$ Integer -> ConversionRate
fromInteger (Integer -> ConversionRate) -> Integer -> ConversionRate
forall a b. (a -> b) -> a -> b
$ SC Integer -> Integer
forall a. SC a -> a
unSC SC Integer
sc') in
(BankState
bs
{ bsStablecoins :: SC Integer
bsStablecoins = BankState -> SC Integer
bsStablecoins BankState
bs SC Integer -> SC Integer -> SC Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ SC Integer
sc'
, bsReserves :: BC Integer
bsReserves = BankState -> BC Integer
bsReserves BankState
bs BC Integer -> BC Integer -> BC Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ (ConversionRate -> Integer) -> BC ConversionRate -> BC Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConversionRate -> Integer
round (BC ConversionRate
fees BC ConversionRate -> BC ConversionRate -> BC ConversionRate
forall a. AdditiveSemigroup a => a -> a -> a
+ BC ConversionRate
scValue)
}, MintingPolicyHash -> TokenName -> Integer -> TxConstraints i o
forall i o.
MintingPolicyHash -> TokenName -> Integer -> TxConstraints i o
Constraints.mustMintCurrency MintingPolicyHash
bsMintingPolicyScript TokenName
scStablecoinTokenName (SC Integer -> Integer
forall a. SC a -> a
unSC SC Integer
sc'))
MintReserveCoin RC Integer
rc ->
let rcValue :: BC ConversionRate
rcValue = Stablecoin -> BankState -> ConversionRate -> BC ConversionRate
reservecoinNominalPrice Stablecoin
sc BankState
bs ConversionRate
rate BC ConversionRate -> BC ConversionRate -> BC ConversionRate
forall a. MultiplicativeSemigroup a => a -> a -> a
* (ConversionRate -> BC ConversionRate
forall a. a -> BC a
BC (ConversionRate -> BC ConversionRate)
-> ConversionRate -> BC ConversionRate
forall a b. (a -> b) -> a -> b
$ Integer -> ConversionRate
fromInteger (Integer -> ConversionRate) -> Integer -> ConversionRate
forall a b. (a -> b) -> a -> b
$ RC Integer -> Integer
forall a. RC a -> a
unRC RC Integer
rc) in
(BankState
bs
{ bsReservecoins :: RC Integer
bsReservecoins = BankState -> RC Integer
bsReservecoins BankState
bs RC Integer -> RC Integer -> RC Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ RC Integer
rc
, bsReserves :: BC Integer
bsReserves = BankState -> BC Integer
bsReserves BankState
bs BC Integer -> BC Integer -> BC Integer
forall a. AdditiveSemigroup a => a -> a -> a
+ (ConversionRate -> Integer) -> BC ConversionRate -> BC Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ConversionRate -> Integer
round (BC ConversionRate
fees BC ConversionRate -> BC ConversionRate -> BC ConversionRate
forall a. AdditiveSemigroup a => a -> a -> a
+ BC ConversionRate
rcValue)
}, MintingPolicyHash -> TokenName -> Integer -> TxConstraints i o
forall i o.
MintingPolicyHash -> TokenName -> Integer -> TxConstraints i o
Constraints.mustMintCurrency MintingPolicyHash
bsMintingPolicyScript TokenName
scReservecoinTokenName (RC Integer -> Integer
forall a. RC a -> a
unRC RC Integer
rc))
let dateConstraints :: TxConstraints i o
dateConstraints = ValidityInterval POSIXTime -> TxConstraints i o
forall i o. ValidityInterval POSIXTime -> TxConstraints i o
Constraints.mustValidateInTimeRange (ValidityInterval POSIXTime -> TxConstraints i o)
-> ValidityInterval POSIXTime -> TxConstraints i o
forall a b. (a -> b) -> a -> b
$ POSIXTime -> ValidityInterval POSIXTime
forall a. a -> ValidityInterval a
Interval.from POSIXTime
obsTime
(TxConstraints i o, BankState)
-> Maybe (TxConstraints i o, BankState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxConstraints i o
constraints TxConstraints i o -> TxConstraints i o -> TxConstraints i o
forall a. Semigroup a => a -> a -> a
<> TxConstraints i o
newConstraints TxConstraints i o -> TxConstraints i o -> TxConstraints i o
forall a. Semigroup a => a -> a -> a
<> TxConstraints i o
dateConstraints, BankState
newState)
{-# INLINEABLE step #-}
step :: forall i o. Stablecoin -> BankState -> Input -> Maybe (TxConstraints i o, BankState)
step :: Stablecoin
-> BankState -> Input -> Maybe (TxConstraints i o, BankState)
step sc :: Stablecoin
sc@Stablecoin{PaymentPubKey
scOracle :: PaymentPubKey
scOracle :: Stablecoin -> PaymentPubKey
scOracle} BankState
bs i :: Input
i@Input{SignedMessage (Observation ConversionRate)
inpConversionRate :: SignedMessage (Observation ConversionRate)
inpConversionRate :: Input -> SignedMessage (Observation ConversionRate)
inpConversionRate} = do
(TxConstraints i o
constraints, BankState
newState) <- Stablecoin
-> BankState -> Input -> Maybe (TxConstraints i o, BankState)
forall i o.
Stablecoin
-> BankState -> Input -> Maybe (TxConstraints i o, BankState)
applyInput Stablecoin
sc BankState
bs Input
i
(Observation{obsValue :: forall a. Observation a -> a
obsValue=ConversionRate
rate}, TxConstraints i o
_ :: TxConstraints i o) <- (SignedMessageCheckError
-> Maybe (Observation ConversionRate, TxConstraints i o))
-> ((Observation ConversionRate, TxConstraints i o)
-> Maybe (Observation ConversionRate, TxConstraints i o))
-> Either
SignedMessageCheckError
(Observation ConversionRate, TxConstraints i o)
-> Maybe (Observation ConversionRate, TxConstraints i o)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (Observation ConversionRate, TxConstraints i o)
-> SignedMessageCheckError
-> Maybe (Observation ConversionRate, TxConstraints i o)
forall a b. a -> b -> a
const Maybe (Observation ConversionRate, TxConstraints i o)
forall a. Maybe a
Nothing) (Observation ConversionRate, TxConstraints i o)
-> Maybe (Observation ConversionRate, TxConstraints i o)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PaymentPubKey
-> SignedMessage (Observation ConversionRate)
-> Either
SignedMessageCheckError
(Observation ConversionRate, TxConstraints i o)
forall a i o.
FromData a =>
PaymentPubKey
-> SignedMessage a
-> Either SignedMessageCheckError (a, TxConstraints i o)
verifySignedMessageConstraints PaymentPubKey
scOracle SignedMessage (Observation ConversionRate)
inpConversionRate)
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Stablecoin -> BankState -> ConversionRate -> Bool
isValidState Stablecoin
sc BankState
newState ConversionRate
rate
(TxConstraints i o, BankState)
-> Maybe (TxConstraints i o, BankState)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxConstraints i o
constraints, BankState
newState)
reserveCoins :: Stablecoin -> RC Integer -> Value
reserveCoins :: Stablecoin -> RC Integer -> Value
reserveCoins sc :: Stablecoin
sc@Stablecoin{TokenName
scReservecoinTokenName :: TokenName
scReservecoinTokenName :: Stablecoin -> TokenName
scReservecoinTokenName} =
let sym :: MintingPolicyHash
sym = TypedValidator (StateMachine BankState Input) -> MintingPolicyHash
forall a. TypedValidator a -> MintingPolicyHash
V2.forwardingMintingPolicyHash (TypedValidator (StateMachine BankState Input)
-> MintingPolicyHash)
-> TypedValidator (StateMachine BankState Input)
-> MintingPolicyHash
forall a b. (a -> b) -> a -> b
$ Stablecoin -> TypedValidator (StateMachine BankState Input)
typedValidator Stablecoin
sc
in CurrencySymbol -> TokenName -> Integer -> Value
Value.singleton (MintingPolicyHash -> CurrencySymbol
Value.mpsSymbol MintingPolicyHash
sym) TokenName
scReservecoinTokenName (Integer -> Value)
-> (RC Integer -> Integer) -> RC Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RC Integer -> Integer
forall a. RC a -> a
unRC
stableCoins :: Stablecoin -> SC Integer -> Value
stableCoins :: Stablecoin -> SC Integer -> Value
stableCoins sc :: Stablecoin
sc@Stablecoin{TokenName
scStablecoinTokenName :: TokenName
scStablecoinTokenName :: Stablecoin -> TokenName
scStablecoinTokenName} =
let sym :: MintingPolicyHash
sym = TypedValidator (StateMachine BankState Input) -> MintingPolicyHash
forall a. TypedValidator a -> MintingPolicyHash
V2.forwardingMintingPolicyHash (TypedValidator (StateMachine BankState Input)
-> MintingPolicyHash)
-> TypedValidator (StateMachine BankState Input)
-> MintingPolicyHash
forall a b. (a -> b) -> a -> b
$ Stablecoin -> TypedValidator (StateMachine BankState Input)
typedValidator Stablecoin
sc
in CurrencySymbol -> TokenName -> Integer -> Value
Value.singleton (MintingPolicyHash -> CurrencySymbol
Value.mpsSymbol MintingPolicyHash
sym) TokenName
scStablecoinTokenName (Integer -> Value)
-> (SC Integer -> Integer) -> SC Integer -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SC Integer -> Integer
forall a. SC a -> a
unSC
{-# INLINEABLE isValidState #-}
isValidState :: Stablecoin -> BankState -> ConversionRate -> Bool
isValidState :: Stablecoin -> BankState -> ConversionRate -> Bool
isValidState Stablecoin
sc BankState
bs ConversionRate
cr = Either InvalidStateReason () -> Bool
forall a b. Either a b -> Bool
isRight (Stablecoin
-> BankState -> ConversionRate -> Either InvalidStateReason ()
checkValidState Stablecoin
sc BankState
bs ConversionRate
cr)
{-# INLINEABLE checkValidState #-}
checkValidState :: Stablecoin -> BankState -> ConversionRate -> Either InvalidStateReason ()
checkValidState :: Stablecoin
-> BankState -> ConversionRate -> Either InvalidStateReason ()
checkValidState Stablecoin
sc bs :: BankState
bs@BankState{RC Integer
bsReservecoins :: RC Integer
bsReservecoins :: BankState -> RC Integer
bsReservecoins, BC Integer
bsReserves :: BC Integer
bsReserves :: BankState -> BC Integer
bsReserves, SC Integer
bsStablecoins :: SC Integer
bsStablecoins :: BankState -> SC Integer
bsStablecoins} ConversionRate
cr = do
Bool
-> Either InvalidStateReason () -> Either InvalidStateReason ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (RC Integer
bsReservecoins RC Integer -> RC Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> RC Integer
forall a. a -> RC a
RC Integer
0) (InvalidStateReason -> Either InvalidStateReason ()
forall a b. a -> Either a b
Left InvalidStateReason
NegativeReserveCoins)
Bool
-> Either InvalidStateReason () -> Either InvalidStateReason ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BC Integer
bsReserves BC Integer -> BC Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> BC Integer
forall a. a -> BC a
BC Integer
0) (InvalidStateReason -> Either InvalidStateReason ()
forall a b. a -> Either a b
Left InvalidStateReason
NegativeReserves)
Bool
-> Either InvalidStateReason () -> Either InvalidStateReason ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SC Integer
bsStablecoins SC Integer -> SC Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> SC Integer
forall a. a -> SC a
SC Integer
0) (InvalidStateReason -> Either InvalidStateReason ()
forall a b. a -> Either a b
Left InvalidStateReason
NegativeStablecoins)
Bool
-> Either InvalidStateReason () -> Either InvalidStateReason ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BankState -> ConversionRate -> BC ConversionRate
liabilities BankState
bs ConversionRate
cr BC ConversionRate -> BC ConversionRate -> Bool
forall a. Ord a => a -> a -> Bool
>= BC ConversionRate
forall a. AdditiveMonoid a => a
zero) (InvalidStateReason -> Either InvalidStateReason ()
forall a b. a -> Either a b
Left InvalidStateReason
NegativeLiabilities)
Bool
-> Either InvalidStateReason () -> Either InvalidStateReason ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BankState -> ConversionRate -> BC ConversionRate
equity BankState
bs ConversionRate
cr BC ConversionRate -> BC ConversionRate -> Bool
forall a. Ord a => a -> a -> Bool
>= BC ConversionRate
forall a. AdditiveMonoid a => a
zero) (InvalidStateReason -> Either InvalidStateReason ()
forall a b. a -> Either a b
Left InvalidStateReason
NegativeEquity)
let actualReserves :: BC ConversionRate
actualReserves = (Integer -> ConversionRate) -> BC Integer -> BC ConversionRate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Integer -> ConversionRate
fromInteger BC Integer
bsReserves
allowedReserves :: Maybe (BC ConversionRate, BC ConversionRate)
allowedReserves = (,) (BC ConversionRate
-> BC ConversionRate -> (BC ConversionRate, BC ConversionRate))
-> Maybe (BC ConversionRate)
-> Maybe
(BC ConversionRate -> (BC ConversionRate, BC ConversionRate))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Stablecoin
-> ConversionRate -> BankState -> Maybe (BC ConversionRate)
minReserve Stablecoin
sc ConversionRate
cr BankState
bs Maybe (BC ConversionRate -> (BC ConversionRate, BC ConversionRate))
-> Maybe (BC ConversionRate)
-> Maybe (BC ConversionRate, BC ConversionRate)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Stablecoin
-> ConversionRate -> BankState -> Maybe (BC ConversionRate)
maxReserve Stablecoin
sc ConversionRate
cr BankState
bs
case Maybe (BC ConversionRate, BC ConversionRate)
allowedReserves of
Just (BC ConversionRate
minReserves, BC ConversionRate
maxReserves) -> do
Bool
-> Either InvalidStateReason () -> Either InvalidStateReason ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BC ConversionRate
actualReserves BC ConversionRate -> BC ConversionRate -> Bool
forall a. Ord a => a -> a -> Bool
>= BC ConversionRate
minReserves) (InvalidStateReason -> Either InvalidStateReason ()
forall a b. a -> Either a b
Left (InvalidStateReason -> Either InvalidStateReason ())
-> InvalidStateReason -> Either InvalidStateReason ()
forall a b. (a -> b) -> a -> b
$ BC ConversionRate -> BC ConversionRate -> InvalidStateReason
MinReserves BC ConversionRate
minReserves BC ConversionRate
actualReserves)
Bool
-> Either InvalidStateReason () -> Either InvalidStateReason ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (BC ConversionRate
actualReserves BC ConversionRate -> BC ConversionRate -> Bool
forall a. Ord a => a -> a -> Bool
<= BC ConversionRate
maxReserves) (InvalidStateReason -> Either InvalidStateReason ()
forall a b. a -> Either a b
Left (InvalidStateReason -> Either InvalidStateReason ())
-> InvalidStateReason -> Either InvalidStateReason ()
forall a b. (a -> b) -> a -> b
$ BC ConversionRate -> BC ConversionRate -> InvalidStateReason
MaxReserves BC ConversionRate
maxReserves BC ConversionRate
actualReserves)
Maybe (BC ConversionRate, BC ConversionRate)
Nothing -> () -> Either InvalidStateReason ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
data InvalidStateReason
= NegativeReserveCoins
| NegativeReserves
| NegativeStablecoins
| MinReserves { InvalidStateReason -> BC ConversionRate
allowed :: BC Rational, InvalidStateReason -> BC ConversionRate
actual :: BC Rational }
| MaxReserves { allowed :: BC Rational, actual :: BC Rational }
| NegativeLiabilities
| NegativeEquity
deriving (Int -> InvalidStateReason -> ShowS
[InvalidStateReason] -> ShowS
InvalidStateReason -> String
(Int -> InvalidStateReason -> ShowS)
-> (InvalidStateReason -> String)
-> ([InvalidStateReason] -> ShowS)
-> Show InvalidStateReason
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InvalidStateReason] -> ShowS
$cshowList :: [InvalidStateReason] -> ShowS
show :: InvalidStateReason -> String
$cshow :: InvalidStateReason -> String
showsPrec :: Int -> InvalidStateReason -> ShowS
$cshowsPrec :: Int -> InvalidStateReason -> ShowS
Haskell.Show)
stablecoinStateMachine :: Stablecoin -> StateMachine BankState Input
stablecoinStateMachine :: Stablecoin -> StateMachine BankState Input
stablecoinStateMachine Stablecoin
sc = Maybe ThreadToken
-> (State BankState
-> Input -> Maybe (TxConstraints Void Void, State BankState))
-> (BankState -> Bool)
-> StateMachine BankState Input
forall s i.
Maybe ThreadToken
-> (State s -> i -> Maybe (TxConstraints Void Void, State s))
-> (s -> Bool)
-> StateMachine s i
SM.mkStateMachine Maybe ThreadToken
forall a. Maybe a
Nothing (Stablecoin
-> State BankState
-> Input
-> Maybe (TxConstraints Void Void, State BankState)
transition Stablecoin
sc) BankState -> Bool
forall p. p -> Bool
isFinal
where isFinal :: p -> Bool
isFinal p
_ = Bool
False
typedValidator :: Stablecoin -> V2.TypedValidator (StateMachine BankState Input)
typedValidator :: Stablecoin -> TypedValidator (StateMachine BankState Input)
typedValidator Stablecoin
stablecoin =
let val :: CompiledCodeIn
DefaultUni DefaultFun (BankState -> Input -> ScriptContext -> Bool)
val = $$(PlutusTx.compile [|| validator ||]) CompiledCode
(Stablecoin -> BankState -> Input -> ScriptContext -> Bool)
-> CompiledCodeIn DefaultUni DefaultFun Stablecoin
-> CompiledCodeIn
DefaultUni DefaultFun (BankState -> Input -> ScriptContext -> Bool)
forall (uni :: * -> *) fun a b.
(Closed uni, Everywhere uni Flat, Flat fun,
Everywhere uni PrettyConst, GShow uni, Pretty fun) =>
CompiledCodeIn uni fun (a -> b)
-> CompiledCodeIn uni fun a -> CompiledCodeIn uni fun b
`PlutusTx.applyCode` Stablecoin -> CompiledCodeIn DefaultUni DefaultFun Stablecoin
forall (uni :: * -> *) a fun.
(Lift uni a, Throwable uni fun, Typecheckable uni fun) =>
a -> CompiledCodeIn uni fun a
PlutusTx.liftCode Stablecoin
stablecoin
validator :: Stablecoin -> ValidatorType (StateMachine BankState Input)
validator Stablecoin
d = StateMachine BankState Input
-> ValidatorType (StateMachine BankState Input)
forall s i.
ToData s =>
StateMachine s i -> ValidatorType (StateMachine s i)
SM.mkValidator (Stablecoin -> StateMachine BankState Input
stablecoinStateMachine Stablecoin
d)
wrap :: (BankState -> Input -> ScriptContext -> Bool) -> UntypedValidator
wrap = (UnsafeFromData BankState, UnsafeFromData Input) =>
(BankState -> Input -> ScriptContext -> Bool) -> UntypedValidator
forall sc d r.
(IsScriptContext sc, UnsafeFromData d, UnsafeFromData r) =>
(d -> r -> sc -> Bool) -> UntypedValidator
Scripts.mkUntypedValidator @Scripts.ScriptContextV2 @BankState @Input
in CompiledCode (ValidatorType (StateMachine BankState Input))
-> CompiledCode
(ValidatorType (StateMachine BankState Input) -> UntypedValidator)
-> TypedValidator (StateMachine BankState Input)
forall a.
CompiledCode (ValidatorType a)
-> CompiledCode (ValidatorType a -> UntypedValidator)
-> TypedValidator a
V2.mkTypedValidator @(StateMachine BankState Input) CompiledCode (ValidatorType (StateMachine BankState Input))
CompiledCodeIn
DefaultUni DefaultFun (BankState -> Input -> ScriptContext -> Bool)
val $$(PlutusTx.compile [|| wrap ||])
machineClient ::
V2.TypedValidator (StateMachine BankState Input)
-> Stablecoin
-> StateMachineClient BankState Input
machineClient :: TypedValidator (StateMachine BankState Input)
-> Stablecoin -> StateMachineClient BankState Input
machineClient TypedValidator (StateMachine BankState Input)
inst Stablecoin
stablecoin =
let machine :: StateMachine BankState Input
machine = Stablecoin -> StateMachine BankState Input
stablecoinStateMachine Stablecoin
stablecoin
in StateMachineInstance BankState Input
-> StateMachineClient BankState Input
forall state input.
StateMachineInstance state input -> StateMachineClient state input
SM.mkStateMachineClient (StateMachine BankState Input
-> TypedValidator (StateMachine BankState Input)
-> StateMachineInstance BankState Input
forall s i.
StateMachine s i
-> TypedValidator (StateMachine s i) -> StateMachineInstance s i
SM.StateMachineInstance StateMachine BankState Input
machine TypedValidator (StateMachine BankState Input)
inst)
type StablecoinSchema =
Endpoint "run step" Input
.\/ Endpoint "initialise" Stablecoin
data StablecoinError =
InitialiseEPError ContractError
| StateMachineError SMContractError
| RunStepError ContractError
deriving stock (Int -> StablecoinError -> ShowS
[StablecoinError] -> ShowS
StablecoinError -> String
(Int -> StablecoinError -> ShowS)
-> (StablecoinError -> String)
-> ([StablecoinError] -> ShowS)
-> Show StablecoinError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StablecoinError] -> ShowS
$cshowList :: [StablecoinError] -> ShowS
show :: StablecoinError -> String
$cshow :: StablecoinError -> String
showsPrec :: Int -> StablecoinError -> ShowS
$cshowsPrec :: Int -> StablecoinError -> ShowS
Haskell.Show, (forall x. StablecoinError -> Rep StablecoinError x)
-> (forall x. Rep StablecoinError x -> StablecoinError)
-> Generic StablecoinError
forall x. Rep StablecoinError x -> StablecoinError
forall x. StablecoinError -> Rep StablecoinError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StablecoinError x -> StablecoinError
$cfrom :: forall x. StablecoinError -> Rep StablecoinError x
Generic)
deriving anyclass ([StablecoinError] -> Encoding
[StablecoinError] -> Value
StablecoinError -> Encoding
StablecoinError -> Value
(StablecoinError -> Value)
-> (StablecoinError -> Encoding)
-> ([StablecoinError] -> Value)
-> ([StablecoinError] -> Encoding)
-> ToJSON StablecoinError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [StablecoinError] -> Encoding
$ctoEncodingList :: [StablecoinError] -> Encoding
toJSONList :: [StablecoinError] -> Value
$ctoJSONList :: [StablecoinError] -> Value
toEncoding :: StablecoinError -> Encoding
$ctoEncoding :: StablecoinError -> Encoding
toJSON :: StablecoinError -> Value
$ctoJSON :: StablecoinError -> Value
ToJSON, Value -> Parser [StablecoinError]
Value -> Parser StablecoinError
(Value -> Parser StablecoinError)
-> (Value -> Parser [StablecoinError]) -> FromJSON StablecoinError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [StablecoinError]
$cparseJSONList :: Value -> Parser [StablecoinError]
parseJSON :: Value -> Parser StablecoinError
$cparseJSON :: Value -> Parser StablecoinError
FromJSON)
makeClassyPrisms ''StablecoinError
instance AsContractError StablecoinError where
_ContractError :: p ContractError (f ContractError)
-> p StablecoinError (f StablecoinError)
_ContractError = p ContractError (f ContractError)
-> p StablecoinError (f StablecoinError)
forall r. AsStablecoinError r => Prism' r ContractError
_InitialiseEPError (p ContractError (f ContractError)
-> p StablecoinError (f StablecoinError))
-> (p ContractError (f ContractError)
-> p ContractError (f ContractError))
-> p ContractError (f ContractError)
-> p StablecoinError (f StablecoinError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p ContractError (f ContractError)
-> p ContractError (f ContractError)
forall r. AsContractError r => Prism' r ContractError
_ContractError
instance AsSMContractError StablecoinError where
_SMContractError :: p SMContractError (f SMContractError)
-> p StablecoinError (f StablecoinError)
_SMContractError = p SMContractError (f SMContractError)
-> p StablecoinError (f StablecoinError)
forall r. AsStablecoinError r => Prism' r SMContractError
_StateMachineError (p SMContractError (f SMContractError)
-> p StablecoinError (f StablecoinError))
-> (p SMContractError (f SMContractError)
-> p SMContractError (f SMContractError))
-> p SMContractError (f SMContractError)
-> p StablecoinError (f StablecoinError)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p SMContractError (f SMContractError)
-> p SMContractError (f SMContractError)
forall r. AsSMContractError r => Prism' r SMContractError
SM._SMContractError
contract :: Promise () StablecoinSchema StablecoinError ()
contract :: Promise () StablecoinSchema StablecoinError ()
contract = forall a w (s :: Row *) e b.
(HasEndpoint "initialise" a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"initialise" ((Stablecoin
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
())
-> Promise
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
())
-> (Stablecoin
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
())
-> Promise
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a b. (a -> b) -> a -> b
$ \Stablecoin
sc -> do
let theClient :: StateMachineClient BankState Input
theClient = TypedValidator (StateMachine BankState Input)
-> Stablecoin -> StateMachineClient BankState Input
machineClient (Stablecoin -> TypedValidator (StateMachine BankState Input)
typedValidator Stablecoin
sc) Stablecoin
sc
BankState
_ <- StateMachineClient BankState Input
-> BankState
-> Value
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
BankState
forall w e state (schema :: Row *) input.
(FromData state, ToData state, ToData input,
AsSMContractError e) =>
StateMachineClient state input
-> state -> Value -> Contract w schema e state
SM.runInitialise StateMachineClient BankState Input
theClient (StateMachineClient BankState Input -> BankState
initialState StateMachineClient BankState Input
theClient) (Integer -> Value
Ada.lovelaceValueOf Integer
1)
Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input)
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input)
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
())
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input)
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a b. (a -> b) -> a -> b
$ Promise
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input)
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input)
forall w (s :: Row *) e a. Promise w s e a -> Contract w s e a
awaitPromise (Promise
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input)
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input))
-> Promise
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input)
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input)
forall a b. (a -> b) -> a -> b
$ forall a w (s :: Row *) e b.
(HasEndpoint "run step" a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
forall (l :: Symbol) a w (s :: Row *) e b.
(HasEndpoint l a s, AsContractError e, FromJSON a) =>
(a -> Contract w s e b) -> Promise w s e b
endpoint @"run step" ((Input
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input))
-> Promise
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input))
-> (Input
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input))
-> Promise
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input)
forall a b. (a -> b) -> a -> b
$ \Input
i -> do
StateMachineClient BankState Input
-> Stablecoin
-> Input
-> Contract () StablecoinSchema StablecoinError ()
checkTransition StateMachineClient BankState Input
theClient Stablecoin
sc Input
i
StateMachineClient BankState Input
-> Input
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(TransitionResult BankState Input)
forall w e state (schema :: Row *) input.
(AsSMContractError e, FromData state, ToData state,
ToData input) =>
StateMachineClient state input
-> input -> Contract w schema e (TransitionResult state input)
SM.runStep StateMachineClient BankState Input
theClient Input
i
checkTransition :: StateMachineClient BankState Input -> Stablecoin -> Input -> Contract () StablecoinSchema StablecoinError ()
checkTransition :: StateMachineClient BankState Input
-> Stablecoin
-> Input
-> Contract () StablecoinSchema StablecoinError ()
checkTransition StateMachineClient BankState Input
theClient Stablecoin
sc i :: Input
i@Input{SignedMessage (Observation ConversionRate)
inpConversionRate :: SignedMessage (Observation ConversionRate)
inpConversionRate :: Input -> SignedMessage (Observation ConversionRate)
inpConversionRate} = do
Maybe (OnChainState BankState Input, Map TxOutRef DecoratedTxOut)
currentState <- (SMContractError -> StablecoinError)
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
SMContractError
(Maybe (OnChainState BankState Input, Map TxOutRef DecoratedTxOut))
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(Maybe (OnChainState BankState Input, Map TxOutRef DecoratedTxOut))
forall w (s :: Row *) e e' a.
(e -> e') -> Contract w s e a -> Contract w s e' a
mapError SMContractError -> StablecoinError
StateMachineError (Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
SMContractError
(Maybe (OnChainState BankState Input, Map TxOutRef DecoratedTxOut))
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(Maybe
(OnChainState BankState Input, Map TxOutRef DecoratedTxOut)))
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
SMContractError
(Maybe (OnChainState BankState Input, Map TxOutRef DecoratedTxOut))
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
(Maybe (OnChainState BankState Input, Map TxOutRef DecoratedTxOut))
forall a b. (a -> b) -> a -> b
$ StateMachineClient BankState Input
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
SMContractError
(Maybe (OnChainState BankState Input, Map TxOutRef DecoratedTxOut))
forall e state i w (schema :: Row *).
(AsSMContractError e, FromData state, ToData state) =>
StateMachineClient state i
-> Contract
w
schema
e
(Maybe (OnChainState state i, Map TxOutRef DecoratedTxOut))
SM.getOnChainState StateMachineClient BankState Input
theClient
case SignedMessage (Observation ConversionRate)
-> Either SignedMessageCheckError (Observation ConversionRate)
forall a.
FromData a =>
SignedMessage a -> Either SignedMessageCheckError a
checkHashOffChain SignedMessage (Observation ConversionRate)
inpConversionRate of
Right Observation{ConversionRate
obsValue :: ConversionRate
obsValue :: forall a. Observation a -> a
obsValue} -> do
case Maybe (OnChainState BankState Input, Map TxOutRef DecoratedTxOut)
currentState of
Just (OnChainState BankState Input
ocs, Map TxOutRef DecoratedTxOut
_) -> do
case Stablecoin
-> BankState -> ConversionRate -> Either InvalidStateReason ()
checkValidState Stablecoin
sc (OnChainState BankState Input -> BankState
forall s i. OnChainState s i -> s
SM.getStateData OnChainState BankState Input
ocs) ConversionRate
obsValue of
Right ()
_ -> String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Haskell.String String
"Current state OK"
Left InvalidStateReason
w -> String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo (String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
())
-> String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a b. (a -> b) -> a -> b
$ String
"Current state is invalid: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> InvalidStateReason -> String
forall a. Show a => a -> String
Haskell.show InvalidStateReason
w String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
". The transition may still be allowed."
case Stablecoin
-> BankState -> Input -> Maybe (TxConstraints Any Any, BankState)
forall i o.
Stablecoin
-> BankState -> Input -> Maybe (TxConstraints i o, BankState)
applyInput Stablecoin
sc (OnChainState BankState Input -> BankState
forall s i. OnChainState s i -> s
SM.getStateData OnChainState BankState Input
ocs) Input
i of
Just (TxConstraints Any Any
_, BankState
newState) -> case Stablecoin
-> BankState -> ConversionRate -> Either InvalidStateReason ()
checkValidState Stablecoin
sc BankState
newState ConversionRate
obsValue of
Right ()
_ -> String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logInfo @Haskell.String String
"New state OK"
Left InvalidStateReason
w -> String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logWarn (String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
())
-> String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a b. (a -> b) -> a -> b
$ String
"New state is invalid: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> InvalidStateReason -> String
forall a. Show a => a -> String
Haskell.show InvalidStateReason
w String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
". The transition is not allowed."
Maybe (TxConstraints Any Any, BankState)
Nothing -> String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logWarn @Haskell.String String
"applyInput is Nothing (transition failed)"
Maybe (OnChainState BankState Input, Map TxOutRef DecoratedTxOut)
Nothing -> String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logWarn @Haskell.String String
"Unable to find current state."
Left SignedMessageCheckError
e -> String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a w (s :: Row *) e. ToJSON a => a -> Contract w s e ()
logWarn (String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
())
-> String
-> Contract
()
('R
'[ "initialise" ':-> (EndpointValue Stablecoin, ActiveEndpoint),
"run step" ':-> (EndpointValue Input, ActiveEndpoint)])
StablecoinError
()
forall a b. (a -> b) -> a -> b
$ String
"Unable to decode oracle value from datum: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SignedMessageCheckError -> String
forall a. Show a => a -> String
Haskell.show SignedMessageCheckError
e
PlutusTx.makeLift ''SC
PlutusTx.makeLift ''RC
PlutusTx.makeLift ''BC
PlutusTx.makeLift ''PC
PlutusTx.makeLift ''BankState
PlutusTx.makeLift ''Stablecoin
PlutusTx.unstableMakeIsData ''BC
PlutusTx.unstableMakeIsData ''SC
PlutusTx.unstableMakeIsData ''RC
PlutusTx.unstableMakeIsData ''PC
PlutusTx.unstableMakeIsData ''BankState
PlutusTx.unstableMakeIsData ''Stablecoin
PlutusTx.unstableMakeIsData ''SCAction
PlutusTx.unstableMakeIsData ''Input