Added Week04 homework + tests (#113)
* Added Week04 homework + tests * Added Week04 homework + tests
* Added Week04 homework + tests * Added Week04 homework + tests
cabal-version: 3.4
name: week04
version: 0.1.0.0
author: IOG's education team
maintainer: [email protected]
license: Apache-2.0
build-type: Simple
common common-all
build-depends: base ^>=4.14.3.0
, aeson
, bytestring
, containers
, cardano-api
, data-default
, plutus-ledger-api
, plutus-tx-plugin
, plutus-tx
, text
, serialise
, utilities
default-language: Haskell2010
ghc-options: -Wall -fobject-code -fno-ignore-interface-pragmas
-fno-omit-interface-pragmas -fno-strictness
-fno-spec-constr -fno-specialise -fexpose-all-unfoldings
-fplugin-opt PlutusTx.Plugin:defer-errors
common common-all-tests
import: common-all
build-depends: QuickCheck
, tasty
, plutus-simple-model
library
import: common-all
hs-source-dirs: homework
exposed-modules: Homework1
Homework2
test-suite week04-homework
import: common-all-tests
type: exitcode-stdio-1.0
main-is: THomework.hs
hs-source-dirs: tests
build-depends: week04
\ No newline at end of file
{
"type": "PlutusScriptV2",
"description": "",
"cborHex": "590ba1590b9e010000323232332232323332223232323232323233223233223232323232333222323232323232323232322323232223232533532323232325335533553353300e500235005222003133350105017335014335016502d0323350153502e35005222001032500110311032133573892012442656e69666963696172793120646964206e6f74207369676e206f7220746f206c6174650003110321533553353300e5002350052220021333501050173350143350163502e3370090011a80291100081919a80aa816019280088188819099ab9c49012842656e69666963696172793220646964206e6f74207369676e206f7220697320746f206561726c79000311355001222222222222005135001220023333573466e1cd55cea80224000466442466002006004646464646464646464646464646666ae68cdc39aab9d500c480008cccccccccccc88888888888848cccccccccccc00403403002c02802402001c01801401000c008cd409c0a0d5d0a80619a8138141aba1500b33502702935742a014666aa056eb940a8d5d0a804999aa815bae502a35742a01066a04e0686ae85401cccd540ac0d5d69aba150063232323333573466e1cd55cea80124000466a0486464646666ae68cdc39aab9d5002480008cd40a8cd40fdd69aba150023043357426ae8940088c98c8114cd5ce02402382189aab9e5001137540026ae854008c8c8c8cccd5cd19b8735573aa0049000119a81499a81fbad35742a00460866ae84d5d1280111931902299ab9c048047043135573ca00226ea8004d5d09aba2500223263204133573808808607e26aae7940044dd50009aba1500533502775c6ae854010ccd540ac0c48004d5d0a801999aa815bae200135742a00460666ae84d5d1280111931901e99ab9c04003f03b135744a00226ae8940044d5d1280089aba25001135744a00226ae8940044d5d1280089aba25001135744a00226ae8940044d55cf280089baa00135742a00860466ae84d5d1280211931901799ab9c03203102d3333573466e1cd55ce9baa0054800080c08c98c80b8cd5ce0188180161999ab9a3370e6aae75401d2000233322212333001004003002375c6ae85401cdd71aba15006375a6ae84d5d1280311931901699ab9c03002f02b102e13263202c3357389201035054350002e135573ca00226ea80044d5d1280089aab9e500113754002446a004444444444444a66a666aa601e2400264246600244a66a004420062002004a0464a66a666ae68cdc780700081981909a8128008a812002108198818990009aa8131108911299a80089a80191000910999a802910011802001199aa98038900080280200089111a801111a801111a802911a801112999a999a8068058030010a99a8008a99a8028999a80600580180388160999a80600580180388160999a80600580180389111a801111a801912999a999a8040038020010a99a80188008814081388140911191919192999a80310a999a80310a999a80410980224c26006930a999a80390980224c2600693080888078a999a80390980224c26006930a999a80310980224c260069308080a999a80290807080788068a999a80290a999a803909802a4c26008930a999a803109802a4c2600893080808070a999a803109802a4c26008930a999a802909802a4c2600893080792999a80290a999a80390a999a80390999a8058050010008b0b0b08078a999a80310a999a80310999a8050048010008b0b0b0807080692999a80210a999a80310a999a80310999a8050048010008b0b0b08070a999a80290a999a80290999a8048040010008b0b0b0806880612999a80190a999a80290a999a80290999a8048040010008b0b0b08068a999a80210a999a80210999a8040038010008b0b0b0806080592999a80110a999a80210a999a80210999a8040038010008b0b0b08060a999a80190a999a80190999a8038030010008b0b0b08058805091a800911111110038910919800801801091091980080180109109198008018010891999999980091199ab9a3370e00400203c03a44a66a666ae68cdc380100080f00e88030a99a999ab9a3371200400203c03a2008200a44666ae68cdc400100080f00e91199ab9a3371200400203c03a44666ae68cdc480100080e80f11199ab9a3371000400203a03c44a66a666ae68cdc480100080f00e8800880111299a999ab9a3371200400203c03a200420022444006244400424440022464460046eb0004c8004d5406c88cccd55cf80092805119a80498021aba1002300335744004036464646666ae68cdc39aab9d5002480008cc8848cc00400c008c038d5d0a80118029aba135744a004464c6403266ae7007006c05c4d55cf280089baa0012323232323333573466e1cd55cea8022400046666444424666600200a0080060046464646666ae68cdc39aab9d5002480008cc8848cc00400c008c05cd5d0a80119a80780b1aba135744a004464c6403c66ae700840800704d55cf280089baa00135742a008666aa010eb9401cd5d0a8019919191999ab9a3370ea0029002119091118010021aba135573ca00646666ae68cdc3a80124004464244460020086eb8d5d09aab9e500423333573466e1d400d20002122200323263202033573804604403c03a03826aae7540044dd50009aba1500233500b75c6ae84d5d1280111931900d19ab9c01d01c018135744a00226ae8940044d55cf280089baa0011335500175ceb44488c88c008dd5800990009aa80c11191999aab9f00225008233500733221233001003002300635573aa004600a6aae794008c010d5d100180c89aba100111220021221223300100400312232323333573466e1d400520002350073005357426aae79400c8cccd5cd19b875002480089401c8c98c8054cd5ce00c00b80980909aab9d5001137540022424460040062244002464646666ae68cdc3a800a400c46424444600800a600e6ae84d55cf280191999ab9a3370ea004900211909111180100298049aba135573ca00846666ae68cdc3a801a400446424444600200a600e6ae84d55cf280291999ab9a3370ea00890001190911118018029bae357426aae7940188c98c804ccd5ce00b00a80880800780709aab9d500113754002464646666ae68cdc39aab9d5002480008cc8848cc00400c008c014d5d0a8011bad357426ae8940088c98c803ccd5ce00900880689aab9e5001137540024646666ae68cdc39aab9d5001480008dd71aba135573ca004464c6401a66ae7004003c02c4dd5000919191919191999ab9a3370ea002900610911111100191999ab9a3370ea004900510911111100211999ab9a3370ea00690041199109111111198008048041bae35742a00a6eb4d5d09aba2500523333573466e1d40112006233221222222233002009008375c6ae85401cdd71aba135744a00e46666ae68cdc3a802a400846644244444446600c01201060186ae854024dd71aba135744a01246666ae68cdc3a8032400446424444444600e010601a6ae84d55cf280591999ab9a3370ea00e900011909111111180280418071aba135573ca018464c6402c66ae7006406005004c04804404003c0384d55cea80209aab9e5003135573ca00426aae7940044dd50009191919191999ab9a3370ea002900111999110911998008028020019bad35742a0086eb4d5d0a8019bad357426ae89400c8cccd5cd19b875002480008c8488c00800cc020d5d09aab9e500623263200f33573802402201a01826aae75400c4d5d1280089aab9e500113754002464646666ae68cdc3a800a400446424460020066eb8d5d09aab9e500323333573466e1d400920002321223002003375c6ae84d55cf280211931900619ab9c00f00e00a009135573aa00226ea8004488c8c8cccd5cd19b87500148010940188cccd5cd19b875002480088d4024c018d5d09aab9e500423333573466e1d400d20002500923263200d33573802001e01601401226aae7540044dd5000890911180180208911001089110009191999ab9a3370ea0029001100311999ab9a3370ea0049000100311931900319ab9c009008004003135573a6ea8005261220021220011200149010350543100112323001001223300330020020011"
}
cradle:
cabal:
\ No newline at end of file
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
module Homework1 where
import Data.Maybe (fromJust)
import Plutus.V2.Ledger.Api (BuiltinData, POSIXTime, PubKeyHash,
ScriptContext (scriptContextTxInfo),
TxInfo (txInfoValidRange),
Validator, from, mkValidatorScript, POSIXTimeRange)
import Plutus.V2.Ledger.Contexts (txSignedBy)
import Plutus.V1.Ledger.Interval (to, contains)
import PlutusTx (compile, unstableMakeIsData)
import PlutusTx.Prelude (Bool, traceIfFalse, ($), (&&), (||), (+))
import Prelude (IO, String)
import Utilities (Network, posixTimeFromIso8601,
printDataToJSON,
validatorAddressBech32, wrap,
writeValidatorToFile)
---------------------------------------------------------------------------------------------------
------------------------------------------ PROMPT -------------------------------------------------
{-
1- Figure out what this (already finished) validator does using all the tools at your disposal.
2- Write the off-chain code necessary to cover all possible interactions with the validator using
the off-chain tool of your choosing.
HINT: If you get stuck, take a look at Week03's lecture
-}
---------------------------------------------------------------------------------------------------
----------------------------------- ON-CHAIN / VALIDATOR ------------------------------------------
data MisteryDatum = MisteryDatum
{ beneficiary1 :: PubKeyHash
, beneficiary2 :: PubKeyHash
, deadline :: POSIXTime
}
unstableMakeIsData ''MisteryDatum
{-# INLINABLE mkMisteryValidator #-}
mkMisteryValidator :: MisteryDatum -> () -> ScriptContext -> Bool
mkMisteryValidator dat () ctx =
traceIfFalse "Benificiary1 did not sign or to late" checkCondition1 ||
traceIfFalse "Benificiary2 did not sign or is to early" checkCondition2
where
txInfo :: TxInfo
txInfo = scriptContextTxInfo ctx
txValidRange :: POSIXTimeRange
txValidRange = txInfoValidRange txInfo
checkCondition1 :: Bool
checkCondition1 = txSignedBy txInfo (beneficiary1 dat) &&
contains (to (deadline dat)) txValidRange
checkCondition2 :: Bool
checkCondition2 = txSignedBy txInfo (beneficiary2 dat) &&
contains (from (1 + deadline dat)) txValidRange
{-# INLINABLE mkWrappedMisteryValidator #-}
mkWrappedMisteryValidator :: BuiltinData -> BuiltinData -> BuiltinData -> ()
mkWrappedMisteryValidator = wrap mkMisteryValidator
validator :: Validator
validator = mkValidatorScript $$(compile [|| mkWrappedMisteryValidator ||])
---------------------------------------------------------------------------------------------------
------------------------------------- HELPER FUNCTIONS --------------------------------------------
saveVal :: IO ()
saveVal = writeValidatorToFile "./assets/mistery1.plutus" validator
misteryAddressBech32 :: Network -> String
misteryAddressBech32 network = validatorAddressBech32 network validator
printMisteryDatumJSON :: PubKeyHash -> PubKeyHash -> String -> IO ()
printMisteryDatumJSON pkh1 pkh2 time = printDataToJSON $ MisteryDatum
{ beneficiary1 = pkh1
, beneficiary2 = pkh2
, deadline = fromJust $ posixTimeFromIso8601 time
}
\ No newline at end of file
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
module Homework2 where
import Plutus.V2.Ledger.Api
import Plutus.V2.Ledger.Contexts (txSignedBy)
import Plutus.V1.Ledger.Interval (contains)
import PlutusTx (applyCode, compile, liftCode)
import PlutusTx.Prelude (Bool (..), (.), traceIfFalse, (&&))
import Utilities (wrap, writeValidatorToFile)
import Prelude (IO)
---------------------------------------------------------------------------------------------------
------------------------------------------ PROMPT -------------------------------------------------
{-
1- Figure out what this (already finished) validator does using all the tools at your disposal.
2- Write the off-chain code necessary to cover all possible interactions with the validator using
the off-chain tool of your choosing.
HINT: If you get stuck, take a look at Week03's lecture
-}
---------------------------------------------------------------------------------------------------
----------------------------------- ON-CHAIN / VALIDATOR ------------------------------------------
{-# INLINABLE mkParameterizedMisteryValidator #-}
-- This should validate if the transaction has a signature from the parameterized beneficiary and the deadline has passed.
mkParameterizedMisteryValidator :: PubKeyHash -> POSIXTime -> () -> ScriptContext -> Bool
mkParameterizedMisteryValidator beneficiary deadline () ctx =
traceIfFalse "not signed by beneficiary" checkSig &&
traceIfFalse "deadline has not passed yet" checkDeadline
where
txInfo :: TxInfo
txInfo = scriptContextTxInfo ctx
txValidRange :: POSIXTimeRange
txValidRange = txInfoValidRange txInfo
checkSig :: Bool
checkSig = txSignedBy txInfo beneficiary
checkDeadline :: Bool
checkDeadline = contains (from deadline) txValidRange
{-# INLINABLE mkWrappedParameterizedMisteryValidator #-}
mkWrappedParameterizedMisteryValidator :: PubKeyHash -> BuiltinData -> BuiltinData -> BuiltinData -> ()
mkWrappedParameterizedMisteryValidator = wrap . mkParameterizedMisteryValidator
validator :: PubKeyHash -> Validator
validator beneficiary = mkValidatorScript ($$(compile [|| mkWrappedParameterizedMisteryValidator ||]) `applyCode` liftCode beneficiary)
---------------------------------------------------------------------------------------------------
------------------------------------- HELPER FUNCTIONS --------------------------------------------
saveVal :: PubKeyHash -> IO ()
saveVal = writeValidatorToFile "./assets/parameterized-Mistery.plutus" . validator
\ No newline at end of file
{-# LANGUAGE NumericUnderscores #-}
module Main where
import Control.Monad (replicateM)
import Plutus.Model
import Plutus.Model.Fork.Ledger.Slot (Slot)
import Plutus.V2.Ledger.Api
import Prelude
import Test.Tasty
import qualified Homework1 as H1
import qualified Homework2 as H2
type Homework1Script = TypedValidator H1.MisteryDatum ()
script1 :: Homework1Script
script1 = TypedValidator $ toV2 H1.validator
type Homework2Script = TypedValidator POSIXTime ()
script2 :: PubKeyHash -> Homework2Script
script2 = TypedValidator . toV2 . H2.validator
setupUsers :: Run [PubKeyHash]
setupUsers = replicateM 3 $ newUser $ ada (Lovelace 1000)
main :: IO ()
main = do
defaultMain $ do
testGroup "Homework tests"
[
testGroup "All times are in POSIXTime (Not slots)"
[ homework1 defaultBabbage
, homework2 defaultBabbage
]
]
homework1 :: MockConfig -> TestTree
homework1 cfg = do
testGroup
"Testing Homework1"
[ testGroup
"Beneficiary 1 signing"
[ good "Deadline: 6000; TxValidRange (5000, 5999)" $ testBeneficiary1 6000 (-999) 0 0
, good "Deadline: 6000; TxValidRange (5000, 6000)" $ testBeneficiary1 6000 (-999) 1 0
, good "Deadline: 6000; TxValidRange (5000, 6999)" $ testBeneficiary1 6000 (-999) 1000 0
, good "Deadline: 6000; TxValidRange (5999, 6001)" $ testBeneficiary1 6000 0 2 0
, good "Deadline: 6000; TxValidRange (6999, 6999)" $ testBeneficiary1 6000 0 0 1
, bad "Deadline: 6000; TxValidRange (7000, 8000)" $ testBeneficiary1 6000 1 1001 1
, bad "Deadline: 6000; TxValidRange (5000, 7000)" $ testBeneficiary1 6000 (-999) 1001 0
, bad "Deadline: 6000; TxValidRange (6000, 7000)" $ testBeneficiary1 6000 (-999) 1 1
, bad "Deadline: 6000; TxValidRange (6999, 7000)" $ testBeneficiary1 6000 0 1 1
]
, testGroup
"Beneficiary 2 signing"
[ good "Deadline: 5000; TxValidRange (6000, 7000)" $ testBeneficiary2 5000 (-999) 1 1
, good "Deadline: 4999; TxValidRange (5000, 6000)" $ testBeneficiary2 4999 (-999) 1 0
, bad "Deadline: 6000; TxValidRange (5000, 5999)" $ testBeneficiary2 6000 (-999) 0 0
, bad "Deadline: 5000; TxValidRange (5000, 6000)" $ testBeneficiary2 5000 (-999) 1 0
, bad "Deadline: 5000; TxValidRange (5001, 6000)" $ testBeneficiary2 5000 (-998) 1 0
, bad "Deadline: 5000; TxValidRange (5999, 6000)" $ testBeneficiary2 5000 0 1 0
]
, bad "None signing" $ testNoSigning 5000 0 0 0
]
where
bad msg = good msg . mustFail
good = testNoErrors (adaValue 10_000_000) cfg
testBeneficiary1 :: POSIXTime -> POSIXTime -> POSIXTime -> Slot -> Run ()
testBeneficiary1 deadline curMinT curMaxT wSlot = do
users <- setupUsers
let [u1, u2, u3] = users
dat = H1.MisteryDatum u1 u2 deadline
testHomework1 u1 u3 dat curMinT curMaxT wSlot
testBeneficiary2 :: POSIXTime -> POSIXTime -> POSIXTime -> Slot -> Run ()
testBeneficiary2 deadline curMinT curMaxT wSlot = do
users <- setupUsers
let [u1, u2, u3] = users
dat = H1.MisteryDatum u1 u2 deadline
testHomework1 u2 u3 dat curMinT curMaxT wSlot
testNoSigning :: POSIXTime -> POSIXTime -> POSIXTime -> Slot -> Run ()
testNoSigning deadline curMinT curMaxT wSlot = do
users <- setupUsers
let [u1, u2, u3] = users
dat = H1.MisteryDatum u1 u2 deadline
testHomework1 u3 u3 dat curMinT curMaxT wSlot
testHomework1 :: PubKeyHash -> PubKeyHash -> H1.MisteryDatum -> POSIXTime -> POSIXTime -> Slot -> Run ()
testHomework1 sigUser receiver dat curMinT curMaxT wSlot = do
let val = adaValue 100
checkBalance (gives sigUser val script1) $ do
sp <- spend sigUser val
submitTx sigUser $ misteryTx1 dat sp val
waitNSlots wSlot
utxos <- utxoAt script1
let [(vestRef, vestOut)] = utxos
checkBalance (gives script1 (txOutValue vestOut) receiver) $ do
range <- currentTimeInterval curMinT curMaxT
tx <- validateIn range $ claimingTx1 receiver dat vestRef (txOutValue vestOut)
submitTx sigUser tx
misteryTx1 :: H1.MisteryDatum -> UserSpend -> Value -> Tx
misteryTx1 dat usp val =
mconcat
[ userSpend usp
, payToScript script1 (HashDatum dat) val
]
claimingTx1 :: PubKeyHash -> H1.MisteryDatum -> TxOutRef -> Value -> Tx
claimingTx1 pkh dat vestRef vestVal =
mconcat
[ spendScript script1 vestRef () dat
, payToKey pkh vestVal
]
homework2 :: MockConfig -> TestTree
homework2 cfg = do
testGroup
"Testing Homework2"
[ good "Deadline: 5000; TxValidRange (6000, 7000)" $ testHomework2 5000 (-999) 1 1
, good "Deadline: 5000; TxValidRange (5000, 5000)" $ testHomework2 5000 (-999) (-999) 0
, good "Deadline: 5000; TxValidRange (5000, 6000)" $ testHomework2 5000 (-999) 1 0
, good "Deadline: 5000; TxValidRange (5001, 6000)" $ testHomework2 5000 (-998) 1 0
, good "Deadline: 5000; TxValidRange (5999, 6000)" $ testHomework2 5000 0 1 0
, bad "Deadline: 5000; TxValidRange (4000, 5000)" $ testHomework2 5000 (-1999) (-999) 0
, bad "Deadline: 5000; TxValidRange (4999, 5000)" $ testHomework2 5000 (-1000) (-999) 0
, bad "Deadline: 5000; TxValidRange (4999, 5999)" $ testHomework2 5000 (-1000) 0 0
]
where
bad msg = good msg . mustFail
good = testNoErrors (adaValue 10_000_000) cfg
testHomework2 :: POSIXTime -> POSIXTime -> POSIXTime -> Slot -> Run ()
testHomework2 dat curMinT curMaxT wSlot = do
users <- setupUsers
let [u1, u2, _u3] = users
val = adaValue 100
checkBalance (gives u1 val $ script2 u2) $ do
sp <- spend u1 val
submitTx u1 $ misteryTx2 u2 dat sp val
waitNSlots wSlot
utxos <- utxoAt $ script2 u2
let [(vestRef, vestOut)] = utxos
checkBalance (gives (script2 u2) (txOutValue vestOut) u2) $ do
range <- currentTimeInterval curMinT curMaxT
tx <- validateIn range $ claimingTx2 u2 dat vestRef (txOutValue vestOut)
submitTx u2 tx
misteryTx2 :: PubKeyHash -> POSIXTime -> UserSpend -> Value -> Tx
misteryTx2 pkh dat usp val =
mconcat
[ userSpend usp
, payToScript (script2 pkh) (HashDatum dat) val
]
claimingTx2 :: PubKeyHash -> POSIXTime -> TxOutRef -> Value -> Tx
claimingTx2 receiver dat vestRef vestVal =
mconcat
[ spendScript (script2 receiver) vestRef () dat
, payToKey receiver vestVal
]
Utilities
Week02
Week03
Week04
-- We never, ever, want this.
write-ghc-environment-files: never
updatet hackage index
Fix db-sync checks of scripts in reference txin