take collaterals into account
This commit is contained in:
parent
5c63764159
commit
5a688262c3
3 changed files with 32 additions and 8 deletions
|
|
@ -14,6 +14,7 @@ import Spec.Sample.Effect.TreasuryWithdrawal (
|
||||||
inputGAT,
|
inputGAT,
|
||||||
inputTreasury,
|
inputTreasury,
|
||||||
inputUser,
|
inputUser,
|
||||||
|
inputCollateral,
|
||||||
outputTreasury,
|
outputTreasury,
|
||||||
outputUser,
|
outputUser,
|
||||||
treasuries,
|
treasuries,
|
||||||
|
|
@ -40,6 +41,7 @@ tests =
|
||||||
datum1
|
datum1
|
||||||
( buildScriptContext
|
( buildScriptContext
|
||||||
[ inputGAT
|
[ inputGAT
|
||||||
|
, inputCollateral 10
|
||||||
, inputTreasury 1 (asset1 10)
|
, inputTreasury 1 (asset1 10)
|
||||||
]
|
]
|
||||||
$ outputTreasury 1 (asset1 7) :
|
$ outputTreasury 1 (asset1 7) :
|
||||||
|
|
@ -51,6 +53,7 @@ tests =
|
||||||
datum1
|
datum1
|
||||||
( buildScriptContext
|
( buildScriptContext
|
||||||
[ inputGAT
|
[ inputGAT
|
||||||
|
, inputCollateral 10
|
||||||
, inputTreasury 1 (asset1 10)
|
, inputTreasury 1 (asset1 10)
|
||||||
, inputTreasury 2 (asset1 100)
|
, inputTreasury 2 (asset1 100)
|
||||||
, inputTreasury 3 (asset1 500)
|
, inputTreasury 3 (asset1 500)
|
||||||
|
|
@ -67,6 +70,7 @@ tests =
|
||||||
datum2
|
datum2
|
||||||
( buildScriptContext
|
( buildScriptContext
|
||||||
[ inputGAT
|
[ inputGAT
|
||||||
|
, inputCollateral 10
|
||||||
, inputTreasury 1 (asset1 20)
|
, inputTreasury 1 (asset1 20)
|
||||||
, inputTreasury 2 (asset2 20)
|
, inputTreasury 2 (asset2 20)
|
||||||
]
|
]
|
||||||
|
|
@ -81,6 +85,7 @@ tests =
|
||||||
datum2
|
datum2
|
||||||
( buildScriptContext
|
( buildScriptContext
|
||||||
[ inputGAT
|
[ inputGAT
|
||||||
|
, inputCollateral 10
|
||||||
, inputTreasury 1 (asset1 20)
|
, inputTreasury 1 (asset1 20)
|
||||||
, inputTreasury 2 (asset2 20)
|
, inputTreasury 2 (asset2 20)
|
||||||
]
|
]
|
||||||
|
|
@ -96,6 +101,7 @@ tests =
|
||||||
datum2
|
datum2
|
||||||
( buildScriptContext
|
( buildScriptContext
|
||||||
[ inputGAT
|
[ inputGAT
|
||||||
|
, inputCollateral 10
|
||||||
, inputTreasury 1 (asset1 20)
|
, inputTreasury 1 (asset1 20)
|
||||||
, inputTreasury 2 (asset2 20)
|
, inputTreasury 2 (asset2 20)
|
||||||
]
|
]
|
||||||
|
|
@ -110,6 +116,7 @@ tests =
|
||||||
datum3
|
datum3
|
||||||
( buildScriptContext
|
( buildScriptContext
|
||||||
[ inputGAT
|
[ inputGAT
|
||||||
|
, inputCollateral 10
|
||||||
, inputTreasury 999 (asset1 20)
|
, inputTreasury 999 (asset1 20)
|
||||||
]
|
]
|
||||||
$ outputTreasury 999 (asset1 17) :
|
$ outputTreasury 999 (asset1 17) :
|
||||||
|
|
@ -122,6 +129,7 @@ tests =
|
||||||
( buildScriptContext
|
( buildScriptContext
|
||||||
[ inputGAT
|
[ inputGAT
|
||||||
, inputTreasury 1 (asset1 20)
|
, inputTreasury 1 (asset1 20)
|
||||||
|
, inputTreasury 999 (asset1 20)
|
||||||
, inputUser 99 (asset2 100)
|
, inputUser 99 (asset2 100)
|
||||||
]
|
]
|
||||||
$ [ outputTreasury 1 (asset1 17)
|
$ [ outputTreasury 1 (asset1 17)
|
||||||
|
|
|
||||||
|
|
@ -9,6 +9,7 @@ module Spec.Sample.Effect.TreasuryWithdrawal (
|
||||||
inputTreasury,
|
inputTreasury,
|
||||||
inputUser,
|
inputUser,
|
||||||
inputGAT,
|
inputGAT,
|
||||||
|
inputCollateral,
|
||||||
outputTreasury,
|
outputTreasury,
|
||||||
outputUser,
|
outputUser,
|
||||||
buildReceiversOutputFromDatum,
|
buildReceiversOutputFromDatum,
|
||||||
|
|
@ -106,6 +107,16 @@ inputUser indx val =
|
||||||
, txOutDatumHash = Just (DatumHash "")
|
, txOutDatumHash = Just (DatumHash "")
|
||||||
}
|
}
|
||||||
|
|
||||||
|
inputCollateral :: Int -> TxInInfo
|
||||||
|
inputCollateral indx =
|
||||||
|
TxInInfo -- Initiator
|
||||||
|
(TxOutRef "" 1)
|
||||||
|
TxOut
|
||||||
|
{ txOutAddress = Address (users !! indx) Nothing
|
||||||
|
, txOutValue = Value.singleton "" "" 2000000
|
||||||
|
, txOutDatumHash = Just (DatumHash "")
|
||||||
|
}
|
||||||
|
|
||||||
outputTreasury :: Int -> Value -> TxOut
|
outputTreasury :: Int -> Value -> TxOut
|
||||||
outputTreasury indx val =
|
outputTreasury indx val =
|
||||||
TxOut
|
TxOut
|
||||||
|
|
|
||||||
|
|
@ -20,12 +20,12 @@ import Agora.Effect (makeEffect)
|
||||||
import Agora.Utils (findTxOutByTxOutRef, paddValue, passert)
|
import Agora.Utils (findTxOutByTxOutRef, paddValue, passert)
|
||||||
import Plutarch (popaque)
|
import Plutarch (popaque)
|
||||||
import Plutarch.Api.V1 (
|
import Plutarch.Api.V1 (
|
||||||
PCredential,
|
|
||||||
PTuple,
|
|
||||||
PValidator,
|
|
||||||
PValue,
|
|
||||||
ptuple,
|
ptuple,
|
||||||
)
|
PValidator,
|
||||||
|
PTuple,
|
||||||
|
PValue,
|
||||||
|
PCredential(..)
|
||||||
|
)
|
||||||
|
|
||||||
import Plutarch.DataRepr (
|
import Plutarch.DataRepr (
|
||||||
DerivePConstantViaData (..),
|
DerivePConstantViaData (..),
|
||||||
|
|
@ -34,7 +34,7 @@ import Plutarch.DataRepr (
|
||||||
)
|
)
|
||||||
import Plutarch.Lift (PUnsafeLiftDecl (..))
|
import Plutarch.Lift (PUnsafeLiftDecl (..))
|
||||||
import Plutarch.Monadic qualified as P
|
import Plutarch.Monadic qualified as P
|
||||||
import Plutus.V1.Ledger.Credential (Credential)
|
import Plutus.V1.Ledger.Credential ( Credential )
|
||||||
import Plutus.V1.Ledger.Value (CurrencySymbol, Value)
|
import Plutus.V1.Ledger.Value (CurrencySymbol, Value)
|
||||||
import PlutusTx qualified
|
import PlutusTx qualified
|
||||||
|
|
||||||
|
|
@ -122,6 +122,10 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
|
||||||
treasuryInputValuesSum = sumValues #$ ofTreasury # inputValues
|
treasuryInputValuesSum = sumValues #$ ofTreasury # inputValues
|
||||||
treasuryOutputValuesSum = sumValues #$ ofTreasury # outputValues
|
treasuryOutputValuesSum = sumValues #$ ofTreasury # outputValues
|
||||||
receiverValuesSum = sumValues # datum.receivers
|
receiverValuesSum = sumValues # datum.receivers
|
||||||
|
isCollateral = plam $ \cred -> P.do
|
||||||
|
pmatch cred $ \case
|
||||||
|
PPubKeyCredential _ -> pcon PTrue
|
||||||
|
PScriptCredential _ -> pcon PFalse
|
||||||
|
|
||||||
-- Constraints
|
-- Constraints
|
||||||
outputContentMatchesRecivers =
|
outputContentMatchesRecivers =
|
||||||
|
|
@ -136,17 +140,18 @@ treasuryWithdrawalValidator currSymbol = makeEffect currSymbol $
|
||||||
effInput.address #== pfield @"address" # pfromData x
|
effInput.address #== pfield @"address" # pfromData x
|
||||||
)
|
)
|
||||||
# pfromData txInfo.outputs
|
# pfromData txInfo.outputs
|
||||||
inputsAreOnlyTreasuries =
|
inputsAreOnlyTreasuriesOrCollateral =
|
||||||
pall
|
pall
|
||||||
# plam
|
# plam
|
||||||
( \((pfield @"_0" #) . pfromData -> cred) ->
|
( \((pfield @"_0" #) . pfromData -> cred) ->
|
||||||
cred #== pfield @"credential" # effInput.address
|
cred #== pfield @"credential" # effInput.address
|
||||||
#|| pelem # cred # datum.treasuries
|
#|| pelem # cred # datum.treasuries
|
||||||
|
#|| isCollateral # pfromData cred
|
||||||
)
|
)
|
||||||
# inputValues
|
# inputValues
|
||||||
|
|
||||||
passert "Transaction should not pay to effects" shouldNotPayToEffect
|
passert "Transaction should not pay to effects" shouldNotPayToEffect
|
||||||
passert "Transaction output does not match receivers" outputContentMatchesRecivers
|
passert "Transaction output does not match receivers" outputContentMatchesRecivers
|
||||||
passert "Remainders should be returned to the treasury" excessShouldBePaidToInputs
|
passert "Remainders should be returned to the treasury" excessShouldBePaidToInputs
|
||||||
passert "Transaction should only have treasuries specified in the datum as input" inputsAreOnlyTreasuries
|
passert "Transaction should only have treasuries specified in the datum as input" inputsAreOnlyTreasuriesOrCollateral
|
||||||
popaque $ pconstant ()
|
popaque $ pconstant ()
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue