Created
April 16, 2021 06:16
-
-
Save shaansundar/d0b7aecab6c4d55d90ebfd58eb96f4a0 to your computer and use it in GitHub Desktop.
A plutus program to check a combination of three boolean logics as a passkey for a valid transaction
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 #-} | |
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 hiding (when) | |
import PlutusTx (Data (..)) | |
import qualified PlutusTx | |
import PlutusTx.Prelude hiding (Semigroup(..), unless) | |
import Ledger hiding (singleton) | |
import Ledger.Constraints as Constraints | |
import qualified Ledger.Scripts as Scripts | |
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 (Semigroup (..)) | |
import Text.Printf (printf) | |
{-# INLINABLE mkValidator #-} | |
-- This should validate if and only if the two Booleans in the redeemer are equal! | |
mkValidator :: () -> (Bool,Bool,Bool) -> ValidatorCtx -> Bool | |
mkValidator () (j,k,l) _ = traceIfFalse "wrong redeemer" $ (j == k && k == l) | |
data Typed | |
instance Scripts.ScriptType Typed where | |
type instance DatumType Typed = () | |
type instance RedeemerType Typed = (Bool,Bool,Bool) | |
inst :: Scripts.ScriptInstance Typed | |
inst = Scripts.validator @Typed | |
$$(PlutusTx.compile [|| mkValidator ||]) | |
$$(PlutusTx.compile [|| wrap ||]) | |
where | |
wrap = Scripts.wrapValidator @() @(Bool,Bool,Bool) | |
validator :: Validator | |
validator = Scripts.validatorScript inst | |
valHash :: Ledger.ValidatorHash | |
valHash = Scripts.validatorHash validator | |
scrAddress :: Ledger.Address | |
scrAddress = ScriptAddress valHash | |
type GiftSchema = | |
BlockchainActions | |
.\/ Endpoint "give" Integer | |
.\/ Endpoint "grab" (Bool,Bool,Bool) | |
give :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e () | |
give amount = do | |
let tx = mustPayToTheScript () $ Ada.lovelaceValueOf amount | |
ledgerTx <- submitTxConstraints inst tx | |
void $ awaitTxConfirmed $ txId ledgerTx | |
logInfo @String $ printf "made a gift of %d lovelace" amount | |
grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => (Bool,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 [] |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment