mirror of
https://github.com/FiloSpaTeam/plutus-pioneer-program.git
synced 2024-11-13 02:12:34 +01:00
removed solutions
This commit is contained in:
parent
77fc203123
commit
598416e299
3 changed files with 0 additions and 193 deletions
|
@ -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
|
||||
|
|
|
@ -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