take collaterals into account

This commit is contained in:
Seungheon Oh 2022-04-25 08:46:58 -04:00
parent 5c63764159
commit 5a688262c3
3 changed files with 32 additions and 8 deletions

View file

@ -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)

View file

@ -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

View file

@ -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 ()