Last active
July 13, 2021 20:31
-
-
Save paulosuzart/7865064b8ddfbac6991c96aa19cee96c to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE NoImplicitPrelude #-} | |
{-# LANGUAGE OverloadedStrings #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TemplateHaskell #-} | |
{-# LANGUAGE TypeApplications #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE TypeOperators #-} | |
{-# OPTIONS_GHC -fno-warn-unused-imports #-} | |
module Week02.Homework1 where | |
import Control.Monad hiding (fmap) | |
import Data.Map as Map | |
import Data.Text (Text) | |
import Data.Void (Void) | |
import Plutus.Contract | |
import qualified PlutusTx | |
import PlutusTx.Prelude hiding (Semigroup(..), unless) | |
import Ledger hiding (singleton) | |
import Ledger.Constraints as Constraints | |
import qualified Ledger.Typed.Scripts as Scripts | |
import Ledger.Ada as Ada | |
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage) | |
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) | |
import Playground.Types (KnownCurrency (..)) | |
import Prelude (IO, Semigroup (..), String, undefined) | |
import Text.Printf (printf) | |
{-# INLINABLE mkValidator #-} | |
-- This should validate if and only if the two Booleans in the redeemer are equal! | |
mkValidator :: () -> (Bool, Bool) -> ScriptContext -> Bool | |
mkValidator _ (s, b) _ = traceIfFalse "wrong redeem" $ s == b | |
data Typed | |
instance Scripts.ValidatorTypes Typed where | |
type instance DatumType Typed = () | |
type instance RedeemerType Typed = (Bool, Bool) | |
typedValidator :: Scripts.TypedValidator Typed | |
typedValidator = Scripts.mkTypedValidator @Typed | |
$$(PlutusTx.compile [|| mkValidator ||]) | |
$$(PlutusTx.compile [|| wrap ||]) | |
where | |
wrap = Scripts.wrapValidator @() @(Bool, Bool) | |
validator :: Validator | |
validator = Scripts.validatorScript typedValidator | |
valHash :: Ledger.ValidatorHash | |
valHash = Scripts.validatorHash typedValidator | |
scrAddress :: Ledger.Address | |
scrAddress = scriptAddress validator | |
type GiftSchema = | |
Endpoint "give" Integer | |
.\/ Endpoint "grab" (Bool, Bool) | |
give :: AsContractError e => Integer -> Contract w s e () | |
give amount = do | |
let tx = mustPayToTheScript () $ Ada.lovelaceValueOf amount | |
ledgerTx <- submitTxConstraints typedValidator tx | |
void $ awaitTxConfirmed $ txId ledgerTx | |
logInfo @String $ printf "made a gift of %d lovelace" amount | |
grab :: forall w s e. AsContractError e => (Bool, Bool) -> Contract w s e () | |
grab bs = do | |
utxos <- utxoAt scrAddress | |
let orefs = fst <$> Map.toList utxos | |
lookups = Constraints.unspentOutputs utxos <> | |
Constraints.otherScript validator | |
tx :: TxConstraints Void Void | |
tx = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData bs | oref <- orefs] | |
ledgerTx <- submitTxConstraintsWith @Void lookups tx | |
void $ awaitTxConfirmed $ txId ledgerTx | |
logInfo @String $ "collected gifts" | |
endpoints :: Contract () GiftSchema Text () | |
endpoints = (give' `select` grab') >> endpoints | |
where | |
give' = endpoint @"give" >>= give | |
grab' = endpoint @"grab" >>= grab | |
mkSchemaDefinitions ''GiftSchema | |
mkKnownCurrencies [] |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE DataKinds #-} | |
{-# LANGUAGE DeriveAnyClass #-} | |
{-# LANGUAGE DeriveGeneric #-} | |
{-# LANGUAGE FlexibleContexts #-} | |
{-# LANGUAGE NoImplicitPrelude #-} | |
{-# LANGUAGE OverloadedStrings #-} | |
{-# LANGUAGE ScopedTypeVariables #-} | |
{-# LANGUAGE TemplateHaskell #-} | |
{-# LANGUAGE TypeApplications #-} | |
{-# LANGUAGE TypeFamilies #-} | |
{-# LANGUAGE TypeOperators #-} | |
{-# LANGUAGE NamedFieldPuns #-} | |
{-# OPTIONS_GHC -fno-warn-unused-imports #-} | |
module Week02.Homework2 where | |
import Control.Monad hiding (fmap) | |
import Data.Aeson (FromJSON, ToJSON) | |
import Data.Map as Map | |
import Data.Text (Text) | |
import Data.Void (Void) | |
import GHC.Generics (Generic) | |
import Plutus.Contract | |
import qualified PlutusTx | |
import PlutusTx.Prelude hiding (Semigroup(..), unless) | |
import Ledger hiding (singleton) | |
import Ledger.Constraints as Constraints | |
import qualified Ledger.Typed.Scripts as Scripts | |
import Ledger.Ada as Ada | |
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema) | |
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions) | |
import Playground.Types (KnownCurrency (..)) | |
import Prelude (IO, Semigroup (..), String, undefined) | |
import Text.Printf (printf) | |
data MyRedeemer = MyRedeemer | |
{ flag1 :: Bool | |
, flag2 :: Bool | |
} deriving (Generic, FromJSON, ToJSON, ToSchema) | |
PlutusTx.unstableMakeIsData ''MyRedeemer | |
{-# INLINABLE mkValidator #-} | |
-- This should validate if and only if the two Booleans in the redeemer are equal! | |
mkValidator :: () -> MyRedeemer -> ScriptContext -> Bool | |
mkValidator _ MyRedeemer {flag1, flag2} _ = traceIfFalse "wrong redeem" $ flag1 == flag2 | |
data Typed | |
instance Scripts.ValidatorTypes Typed where | |
type instance DatumType Typed = () | |
type instance RedeemerType Typed = MyRedeemer | |
typedValidator :: Scripts.TypedValidator Typed | |
typedValidator = Scripts.mkTypedValidator @Typed | |
$$(PlutusTx.compile [|| mkValidator ||]) | |
$$(PlutusTx.compile [|| wrap ||]) | |
where | |
wrap = Scripts.wrapValidator @() @MyRedeemer | |
validator :: Validator | |
validator = Scripts.validatorScript typedValidator | |
valHash :: Ledger.ValidatorHash | |
valHash = Scripts.validatorHash typedValidator | |
scrAddress :: Ledger.Address | |
scrAddress = scriptAddress validator | |
type GiftSchema = | |
Endpoint "give" Integer | |
.\/ Endpoint "grab" MyRedeemer | |
give :: AsContractError e => Integer -> Contract w s e () | |
give amount = do | |
let tx = mustPayToTheScript () $ Ada.lovelaceValueOf amount | |
ledgerTx <- submitTxConstraints typedValidator tx | |
void $ awaitTxConfirmed $ txId ledgerTx | |
logInfo @String $ printf "made a gift of %d lovelace" amount | |
grab :: forall w s e. AsContractError e => MyRedeemer -> Contract w s e () | |
grab r = do | |
utxos <- utxoAt scrAddress | |
let orefs = fst <$> Map.toList utxos | |
lookups = Constraints.unspentOutputs utxos <> | |
Constraints.otherScript validator | |
tx :: TxConstraints Void Void | |
tx = mconcat [mustSpendScriptOutput oref $ Redeemer $ PlutusTx.toData r | oref <- orefs] | |
ledgerTx <- submitTxConstraintsWith @Void lookups tx | |
void $ awaitTxConfirmed $ txId ledgerTx | |
logInfo @String $ "collected gifts" | |
endpoints :: Contract () GiftSchema Text () | |
endpoints = (give' `select` grab') >> endpoints | |
where | |
give' = endpoint @"give" >>= give | |
grab' = endpoint @"grab" >>= grab | |
mkSchemaDefinitions ''GiftSchema | |
mkKnownCurrencies [] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment