{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} {-# 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 r x) _ = traceIfFalse "Flags dont match" $ r == x data Typed instance Scripts.ValidatorTypes Typed where type instance DatumType Typed = () type instance RedeemerType Typed = MyRedeemer typedValidator :: Scripts.TypedValidator Typed typedValidator = Scripts.mkTypedValidator @Typed -- FIX ME! $$(PlutusTx.compile [|| mkValidator ||]) $$(PlutusTx.compile [|| wrap ||]) where wrap = Scripts.wrapValidator @() @MyRedeemer validator :: Validator validator = Scripts.validatorScript typedValidator -- FIX ME! valHash :: Ledger.ValidatorHash valHash = Scripts.validatorHash typedValidator -- FIX ME! scrAddress :: Ledger.Address scrAddress = scriptAddress validator -- FIX ME! 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 []