mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-21 22:32:00 +01:00
removed solutions
This commit is contained in:
Lars Brünjes
parent
77fc203123
commit
598416e299
3 changed files with 0 additions and 193 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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 []
|
|
||||||
|
|
@ -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 []
|
|
||||||
Loading…
Reference in a new issue