burn script

This commit is contained in:
Lars Brünjes 2021-04-09 23:21:14 +02:00
parent ba7dc9d479
commit 5603757c3b
No known key found for this signature in database
GPG key ID: B488B9045DC1A087
2 changed files with 88 additions and 1 deletions

View file

@ -10,7 +10,8 @@ License-files: LICENSE
library
hs-source-dirs: src
exposed-modules: Week02.Gift
exposed-modules: Week02.Burn
, Week02.Gift
build-depends: aeson
, base ^>=4.14.1.0
, containers

View file

@ -0,0 +1,86 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
module Week02.Burn
( burn
, grab
, endpoints
, schemas
, registeredKnownCurrencies
, printJson
, printSchemas
, ensureKnownCurrencies
, stage
) where
import Control.Monad hiding (fmap)
import Data.Map as Map
import Data.Text (Text)
import Data.Void (Void)
import Plutus.Contract hiding (when)
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
import Ledger.Ada as Ada
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage)
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions)
import Playground.Types (KnownCurrency (..))
import Prelude (Semigroup (..))
import Text.Printf (printf)
{-# INLINABLE mkGiftValidator #-}
mkGiftValidator :: Data -> Data -> Data -> ()
mkGiftValidator _ _ _ = traceError "NO WAY!"
giftValidator :: Validator
giftValidator = mkValidatorScript $$(PlutusTx.compile [|| mkGiftValidator ||])
giftHash :: Ledger.ValidatorHash
giftHash = Scripts.validatorHash giftValidator
giftAddress :: Ledger.Address
giftAddress = ScriptAddress giftHash
type GiftSchema =
BlockchainActions
.\/ Endpoint "burn" Integer
.\/ Endpoint "grab" ()
burn :: (HasBlockchainActions s, AsContractError e) => Integer -> Contract w s e ()
burn amount = do
let tx = mustPayToOtherScript giftHash (Datum $ I 42) $ Ada.lovelaceValueOf amount
ledgerTx <- submitTx tx
void $ awaitTxConfirmed $ txId ledgerTx
logInfo @String $ printf "burnt %d lovelace" amount
grab :: forall w s e. (HasBlockchainActions s, AsContractError e) => Contract w s e ()
grab = do
utxos <- utxoAt $ ScriptAddress giftHash
let orefs = fst <$> Map.toList utxos
lookups = Constraints.unspentOutputs utxos <>
Constraints.otherScript giftValidator
tx :: TxConstraints Void Void
tx = mconcat [mustSpendScriptOutput oref $ Redeemer $ I 17 | 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 @"burn" >>= burn
grab' = endpoint @"grab" >> grab
mkSchemaDefinitions ''GiftSchema
mkKnownCurrencies []