From 598416e29986848fd87e9d04ad42de9b161b4284 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Lars=20Br=C3=BCnjes?= Date: Wed, 7 Jul 2021 23:36:59 +0200 Subject: [PATCH] removed solutions --- .../plutus-pioneer-program-week02.cabal | 2 - code/week02/src/Week02/Solution1.hs | 91 ---------------- code/week02/src/Week02/Solution2.hs | 100 ------------------ 3 files changed, 193 deletions(-) delete mode 100644 code/week02/src/Week02/Solution1.hs delete mode 100644 code/week02/src/Week02/Solution2.hs diff --git a/code/week02/plutus-pioneer-program-week02.cabal b/code/week02/plutus-pioneer-program-week02.cabal index d60115b..d88f361 100644 --- a/code/week02/plutus-pioneer-program-week02.cabal +++ b/code/week02/plutus-pioneer-program-week02.cabal @@ -16,8 +16,6 @@ library , Week02.Homework2 , Week02.Gift , Week02.IsData - , Week02.Solution1 - , Week02.Solution2 , Week02.Typed build-depends: aeson , base ^>=4.14.1.0 diff --git a/code/week02/src/Week02/Solution1.hs b/code/week02/src/Week02/Solution1.hs deleted file mode 100644 index 06be1c1..0000000 --- a/code/week02/src/Week02/Solution1.hs +++ /dev/null @@ -1,91 +0,0 @@ -{-# 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.Solution1 where - -import Control.Monad hiding (fmap) -import Data.Map as Map -import Data.Text (Text) -import Data.Void (Void) -import Plutus.Contract -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 hiding (validatorHash) -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) -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 () (b, c) _ = traceIfFalse "wrong redeemer" $ b == c - -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 [] diff --git a/code/week02/src/Week02/Solution2.hs b/code/week02/src/Week02/Solution2.hs deleted file mode 100644 index f9d1762..0000000 --- a/code/week02/src/Week02/Solution2.hs +++ /dev/null @@ -1,100 +0,0 @@ -{-# 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.Solution2 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) -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 b c) _ = traceIfFalse "wrong redeemer" $ b == c - -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 []