withdrawal effect that actually passes tests
This commit is contained in:
Seungheon Oh
parent
6c02b94e16
commit
bed2f37c2f
3 changed files with 165 additions and 163 deletions
|
|
@ -7,17 +7,17 @@ This module tests the Treasury Withdrawal Effect.
|
|||
-}
|
||||
module Spec.Effect.TreasuryWithdrawalEffect (currSymbol, signer, validator, validatorHashTN, scriptContext1, tests) where
|
||||
|
||||
import Plutarch.Evaluate
|
||||
import Plutarch.Builtin
|
||||
import Plutarch.Api.V1
|
||||
import Plutarch.Builtin
|
||||
import Plutarch.Evaluate
|
||||
import Plutus.V1.Ledger.Api
|
||||
import Plutus.V1.Ledger.Interval qualified as Interval
|
||||
import Plutus.V1.Ledger.Value qualified as Value
|
||||
|
||||
import Data.ByteString.Hash
|
||||
|
||||
import Agora.Effect.TreasuryWithdrawal
|
||||
import Agora.AuthorityToken
|
||||
import Agora.Effect.TreasuryWithdrawal
|
||||
|
||||
import Spec.Util
|
||||
|
||||
|
|
@ -65,9 +65,9 @@ _aa = treasuries
|
|||
datum :: TreasuryWithdrawalDatum
|
||||
datum =
|
||||
TreasuryWithdrawalDatum
|
||||
[ (users !! 0, Value.singleton gtSymbol gtToken 1)
|
||||
, (users !! 1, Value.singleton gtSymbol gtToken 1)
|
||||
, (users !! 2, Value.singleton gtSymbol gtToken 1)
|
||||
[ (users !! 0, Value.singleton "1234ab" "LQ" 1)
|
||||
, (users !! 1, Value.singleton "1234ab" "LQ" 1)
|
||||
, (users !! 2, Value.singleton "1234ab" "LQ" 1)
|
||||
]
|
||||
|
||||
-- | Effect validator instance.
|
||||
|
|
@ -83,7 +83,7 @@ scriptContext1 =
|
|||
ScriptContext
|
||||
{ scriptContextTxInfo =
|
||||
TxInfo
|
||||
{ txInfoInputs =
|
||||
{ txInfoInputs =
|
||||
[ TxInInfo -- Initiator
|
||||
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
|
||||
TxOut
|
||||
|
|
@ -91,48 +91,48 @@ scriptContext1 =
|
|||
, txOutValue = Value.singleton currSymbol validatorHashTN 1 -- Stake ST
|
||||
, txOutDatumHash = Just (DatumHash "")
|
||||
}
|
||||
-- , TxInInfo -- Treasury 1
|
||||
-- (TxOutRef "0b121212121212121212121212121212121212121212121212121221" 2)
|
||||
-- TxOut
|
||||
-- { txOutAddress = Address (treasuries !! 0) Nothing
|
||||
-- , txOutValue = Value.singleton gtSymbol gtToken 10
|
||||
-- , txOutDatumHash = Just (DatumHash "")
|
||||
-- }
|
||||
-- , TxInInfo -- Treasury 2
|
||||
-- (TxOutRef "0b121212121212121212a41212121212121212121212121212121221" 3)
|
||||
-- TxOut
|
||||
-- { txOutAddress = Address (treasuries !! 1) Nothing
|
||||
-- , txOutValue = Value.singleton "1234ab" "LQLQLQL" 10
|
||||
-- , txOutDatumHash = Just (DatumHash "")
|
||||
-- }
|
||||
, TxInInfo -- Treasury 1
|
||||
(TxOutRef "0b121212121212121212121212121212121212121212121212121221" 2)
|
||||
TxOut
|
||||
{ txOutAddress = Address (treasuries !! 0) Nothing
|
||||
, txOutValue = Value.singleton "1234ab" "LQ" 10
|
||||
, txOutDatumHash = Just (DatumHash "")
|
||||
}
|
||||
, TxInInfo -- Treasury 2
|
||||
(TxOutRef "0b121212121212121212a41212121212121212121212121212121221" 3)
|
||||
TxOut
|
||||
{ txOutAddress = Address (treasuries !! 1) Nothing
|
||||
, txOutValue = Value.singleton "1234ab" "LQ" 10
|
||||
, txOutDatumHash = Just (DatumHash "")
|
||||
}
|
||||
]
|
||||
, txInfoOutputs =
|
||||
, txInfoOutputs =
|
||||
[ TxOut
|
||||
{ txOutAddress = Address (users !! 0) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 1
|
||||
, txOutValue = Value.singleton "1234ab" "LQ" 1
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
, TxOut
|
||||
{ txOutAddress = Address (users !! 1) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 1
|
||||
, txOutValue = Value.singleton "1234ab" "LQ" 1
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
, TxOut
|
||||
{ txOutAddress = Address (users !! 2) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 1
|
||||
, txOutValue = Value.singleton "1234ab" "LQ" 1
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
-- Send left overs to treasuries
|
||||
, TxOut
|
||||
, -- Send left overs to treasuries
|
||||
TxOut
|
||||
{ txOutAddress = Address (treasuries !! 0) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 7
|
||||
, txOutValue = Value.singleton "1234ab" "LQ" 7
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
, TxOut
|
||||
{ txOutAddress = Address (treasuries !! 1) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 10
|
||||
, txOutValue = Value.singleton "1234ab" "LQ" 10
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
}
|
||||
]
|
||||
, txInfoFee = Value.singleton "" "" 2
|
||||
, txInfoMint = Value.singleton currSymbol validatorHashTN (-1)
|
||||
|
|
@ -147,103 +147,111 @@ scriptContext1 =
|
|||
Spending (TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
|
||||
}
|
||||
|
||||
|
||||
tests :: [TestTree]
|
||||
tests =
|
||||
[ testGroup
|
||||
"effect"
|
||||
[ effectFailsWith "test1" (treasuryWithdrawalValidator currSymbol) datum scriptContext1]
|
||||
"effect"
|
||||
[effectSucceedsWith "test1" (treasuryWithdrawalValidator currSymbol) datum scriptContext1]
|
||||
]
|
||||
|
||||
_asdfa :: IO ()
|
||||
_asdfa = do
|
||||
let (res, _budget, traces) = evalScript $ compile ((treasuryWithdrawalValidator currSymbol) # pforgetData (pconstantData datum) # pforgetData (pconstantData ()) # pconstant scriptContext1)
|
||||
case res of
|
||||
Left e -> do
|
||||
putStrLn $ show e <> " Traces: " <> show traces
|
||||
Right _v ->
|
||||
pure ()
|
||||
let (res, _budget, traces) = evalScript $ compile ((treasuryWithdrawalValidator currSymbol) # pforgetData (pconstantData datum) # pforgetData (pconstantData ()) # pconstant scriptContext1)
|
||||
case res of
|
||||
Left e -> do
|
||||
putStrLn $ show e <> " Traces: " <> show traces
|
||||
Right _v ->
|
||||
pure ()
|
||||
|
||||
_test :: IO ()
|
||||
_test = do
|
||||
let (res, _budget, traces) = evalScript $ compile (authorityTokensValidIn # pconstant currSymbol # (pconstant $
|
||||
TxOut { txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing ,
|
||||
txOutValue = Value.singleton currSymbol validatorHashTN 1,
|
||||
txOutDatumHash = Just (DatumHash "")}))
|
||||
case res of
|
||||
Left e -> do
|
||||
putStrLn $ show e <> " Traces: " <> show traces
|
||||
Right _v ->
|
||||
pure ()
|
||||
let (res, _budget, traces) =
|
||||
evalScript $
|
||||
compile
|
||||
( authorityTokensValidIn # pconstant currSymbol
|
||||
# ( pconstant $
|
||||
TxOut
|
||||
{ txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
|
||||
, txOutValue = Value.singleton currSymbol validatorHashTN 1
|
||||
, txOutDatumHash = Just (DatumHash "")
|
||||
}
|
||||
)
|
||||
)
|
||||
case res of
|
||||
Left e -> do
|
||||
putStrLn $ show e <> " Traces: " <> show traces
|
||||
Right _v ->
|
||||
pure ()
|
||||
|
||||
_test2 :: IO()
|
||||
_test2 :: IO ()
|
||||
_test2 = do
|
||||
let (res, _budget, traces) = evalScript $ compile (singleAuthorityTokenBurned (pconstant currSymbol) (pconstantData tinfo) (pconstant mv))
|
||||
case res of
|
||||
Left e -> do
|
||||
putStrLn $ show e <> " Traces: " <> show traces
|
||||
Right _v ->
|
||||
putStrLn $ show res
|
||||
where
|
||||
mv = mempty -- Value.singleton currSymbol validatorHashTN (1)
|
||||
tinfo = TxInfo
|
||||
{ txInfoInputs =
|
||||
[ TxInInfo -- Initiator
|
||||
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
|
||||
TxOut
|
||||
{ txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
|
||||
, txOutValue = mempty
|
||||
, txOutDatumHash = Just (DatumHash "")
|
||||
}
|
||||
, TxInInfo -- Treasury 1
|
||||
(TxOutRef "0b121212121212121212121212121212121212121212121212121221" 2)
|
||||
TxOut
|
||||
{ txOutAddress = Address (treasuries !! 0) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 10
|
||||
, txOutDatumHash = Just (DatumHash "")
|
||||
}
|
||||
, TxInInfo -- Treasury 2
|
||||
(TxOutRef "0b121212121212121212a41212121212121212121212121212121221" 3)
|
||||
TxOut
|
||||
{ txOutAddress = Address (treasuries !! 1) Nothing
|
||||
, txOutValue = Value.singleton "1234ab" "LQLQLQL" 10
|
||||
, txOutDatumHash = Just (DatumHash "")
|
||||
}
|
||||
]
|
||||
, txInfoOutputs =
|
||||
[ TxOut
|
||||
{ txOutAddress = Address (users !! 0) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 1
|
||||
, txOutDatumHash = Nothing
|
||||
let (res, _budget, traces) = evalScript $ compile (singleAuthorityTokenBurned (pconstant currSymbol) (pconstantData tinfo) (pconstant mv))
|
||||
case res of
|
||||
Left e -> do
|
||||
putStrLn $ show e <> " Traces: " <> show traces
|
||||
Right _v ->
|
||||
putStrLn $ show res
|
||||
where
|
||||
mv = mempty -- Value.singleton currSymbol validatorHashTN (1)
|
||||
tinfo =
|
||||
TxInfo
|
||||
{ txInfoInputs =
|
||||
[ TxInInfo -- Initiator
|
||||
(TxOutRef "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be" 1)
|
||||
TxOut
|
||||
{ txOutAddress = Address (ScriptCredential $ validatorHash validator) Nothing
|
||||
, txOutValue = mempty
|
||||
, txOutDatumHash = Just (DatumHash "")
|
||||
}
|
||||
, TxOut
|
||||
{ txOutAddress = Address (users !! 1) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 1
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
, TxOut
|
||||
{ txOutAddress = Address (users !! 2) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 1
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
-- Send left overs to treasuries
|
||||
, TxOut
|
||||
, TxInInfo -- Treasury 1
|
||||
(TxOutRef "0b121212121212121212121212121212121212121212121212121221" 2)
|
||||
TxOut
|
||||
{ txOutAddress = Address (treasuries !! 0) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 7
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
, TxOut
|
||||
{ txOutAddress = Address (treasuries !! 1) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 10
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
]
|
||||
, txInfoFee = Value.singleton "" "" 2
|
||||
, txInfoMint = mempty -- Value.singleton currSymbol validatorHashTN (-1)
|
||||
, txInfoDCert = []
|
||||
, txInfoWdrl = []
|
||||
, txInfoValidRange = Interval.always
|
||||
, txInfoSignatories = [signer]
|
||||
, txInfoData = []
|
||||
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
|
||||
}
|
||||
, txOutDatumHash = Just (DatumHash "")
|
||||
}
|
||||
, TxInInfo -- Treasury 2
|
||||
(TxOutRef "0b121212121212121212a41212121212121212121212121212121221" 3)
|
||||
TxOut
|
||||
{ txOutAddress = Address (treasuries !! 1) Nothing
|
||||
, txOutValue = Value.singleton "1234ab" "LQLQLQL" 10
|
||||
, txOutDatumHash = Just (DatumHash "")
|
||||
}
|
||||
]
|
||||
, txInfoOutputs =
|
||||
[ TxOut
|
||||
{ txOutAddress = Address (users !! 0) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 1
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
, TxOut
|
||||
{ txOutAddress = Address (users !! 1) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 1
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
, TxOut
|
||||
{ txOutAddress = Address (users !! 2) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 1
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
, -- Send left overs to treasuries
|
||||
TxOut
|
||||
{ txOutAddress = Address (treasuries !! 0) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 7
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
, TxOut
|
||||
{ txOutAddress = Address (treasuries !! 1) Nothing
|
||||
, txOutValue = Value.singleton gtSymbol gtToken 10
|
||||
, txOutDatumHash = Nothing
|
||||
}
|
||||
]
|
||||
, txInfoFee = Value.singleton "" "" 2
|
||||
, txInfoMint = mempty -- Value.singleton currSymbol validatorHashTN (-1)
|
||||
, txInfoDCert = []
|
||||
, txInfoWdrl = []
|
||||
, txInfoValidRange = Interval.always
|
||||
, txInfoSignatories = [signer]
|
||||
, txInfoData = []
|
||||
, txInfoId = "0b2086cbf8b6900f8cb65e012de4516cb66b5cb08a9aaba12a8b88be"
|
||||
}
|
||||
|
|
|
|||
|
|
@ -131,7 +131,6 @@ validatorFailsWith tag policy datum redeemer scriptContext =
|
|||
# pconstant scriptContext
|
||||
)
|
||||
|
||||
|
||||
-- | Check that a validator script succeeds, given a name and arguments.
|
||||
effectSucceedsWith ::
|
||||
( PLift datum
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue