claudiomaradonna/plutus-pioneer-program
1
0
Fork 0
mirror of https://github.com/FiloSpaTeam/plutus-pioneer-program.git synced 2024-11-14 10:52:35 +01:00
Code Issues Projects Releases Packages Wiki Activity

removed solutions

Browse source
This commit is contained in:
Lars Brünjes 2021-07-07 23:36:59 +02:00
parent 77fc203123
commit 598416e299
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
3 changed files with 0 additions and 193 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
code/week02/plutus-pioneer-program-week02.cabal
View file

@ -16,8 +16,6 @@ library
, Week02.Homework2 , Week02.Homework2
, Week02.Gift , Week02.Gift
, Week02.IsData , Week02.IsData
, Week02.Solution1
, Week02.Solution2
, Week02.Typed , Week02.Typed
build-depends: aeson build-depends: aeson
, base ^>=4.14.1.0 , base ^>=4.14.1.0

91
code/week02/src/Week02/Solution1.hs
View file

@ -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 []

100
code/week02/src/Week02/Solution2.hs
View file

@ -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 []