Skip to content

Instantly share code, notes, and snippets.

@ilap
Last active October 2, 2021 23:23
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save ilap/d5a58fd693b4b8f058a12f4b2e889cfa to your computer and use it in GitHub Desktop.
Save ilap/d5a58fd693b4b8f058a12f4b2e889cfa to your computer and use it in GitHub Desktop.
Plutus Playground Smart Contract
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DerivingVia #-}
module Fracada where
import Prelude (IO, String, show, Show)
import Control.Monad hiding (fmap)
import qualified Data.Map as Map
import Data.Text (Text)
import Data.Void (Void)
import Plutus.Contract as Contract
import qualified PlutusTx
import PlutusTx.IsData
import PlutusTx.Prelude hiding (Semigroup(..), unless)
import Ledger hiding (singleton)
import Ledger.Constraints as Constraints
import qualified Ledger.Typed.Scripts as Scripts
import qualified Ledger.Contexts as Validation
import Ledger.Value as Value
import Playground.Contract (printJson, printSchemas, ensureKnownCurrencies, stage, ToSchema, NonEmpty(..) )
import Playground.TH (mkKnownCurrencies, mkSchemaDefinitions, ensureKnownCurrencies)
import Playground.Types (KnownCurrency (..))
import Plutus.Trace.Emulator as Emulator
import Prelude (Semigroup (..))
import Text.Printf (printf)
import GHC.Generics (Generic)
import Data.Aeson (ToJSON, FromJSON)
import Wallet.Emulator.Wallet
data FractionNFTDatum = FractionNFTDatum {
tokensClass :: AssetClass,
totalFractions :: Integer,
owner :: PubKeyHash
} deriving (Generic, Show)
PlutusTx.makeLift ''FractionNFTDatum
PlutusTx.makeIsDataIndexed ''FractionNFTDatum [('FractionNFTDatum,0)]
-- | Datum and redeemer parameter types for fractioning script
data Fractioning
instance Scripts.ValidatorTypes Fractioning where
type instance RedeemerType Fractioning = ()
type instance DatumType Fractioning = FractionNFTDatum
{-# INLINABLE datumToData #-}
datumToData :: (FromData a) => Datum -> Maybe a
datumToData datum = fromBuiltinData (getDatum datum)
{-# INLINABLE fractionNftValidator #-}
fractionNftValidator :: AssetClass -> FractionNFTDatum -> () -> ScriptContext -> Bool
fractionNftValidator nftAsset FractionNFTDatum{tokensClass, totalFractions, owner} _ ctx =
let
txInfo = scriptContextTxInfo ctx
-- extract signer of this transaction, assume is only one
[sig] = txInfoSignatories txInfo
forgedTokens = assetClassValueOf (txInfoMint txInfo) tokensClass
nftIsLocked = assetClassValueOf ( Validation.valueLockedBy txInfo (Validation.ownHash ctx)) nftAsset == 1
in
if (nftIsLocked) then
let
(_, ownDatumHash) = ownHashes ctx
[(_,newDatum)] = filter (\(h,d) -> h /= ownDatumHash) $ txInfoData txInfo
Just FractionNFTDatum{totalFractions=newTotalFractions} = datumToData newDatum
tokensMinted = forgedTokens == totalFractions
in
-- check fractions input = 0 output = n
-- owner is same
-- tokens minted
traceIfFalse "NFT already fractioned" (totalFractions == 0) &&
traceIfFalse "NFT not fractioned" (newTotalFractions > 0) &&
traceIfFalse "Tokens not minted" tokensMinted &&
traceIfFalse "Owner not the same" (owner == sig)
else
let
tokensBurnt = forgedTokens == negate totalFractions && forgedTokens /= 0
nftIsPaidToOwner = assetClassValueOf (Validation.valuePaidTo txInfo sig ) nftAsset == 1
in
traceIfFalse "NFT not paid to owner" nftIsPaidToOwner &&
traceIfFalse "Tokens not burn" tokensBurnt
fractionNftValidatorInstance :: AssetClass -> Scripts.TypedValidator Fractioning
fractionNftValidatorInstance asset = Scripts.mkTypedValidator @Fractioning
($$(PlutusTx.compile [|| fractionNftValidator ||])
`PlutusTx.applyCode`
PlutusTx.liftCode asset)
$$(PlutusTx.compile [|| wrap ||]) where
wrap = Scripts.wrapValidator @FractionNFTDatum @()
fractionNftValidatorHash :: AssetClass -> ValidatorHash
fractionNftValidatorHash = Scripts.validatorHash . fractionNftValidatorInstance
fractionValidatorScript :: AssetClass -> Validator
fractionValidatorScript = Scripts.validatorScript . fractionNftValidatorInstance
fractionNftValidatorAddress :: AssetClass -> Address
fractionNftValidatorAddress = Ledger.scriptAddress . fractionValidatorScript
{-# INLINABLE mintFractionTokens #-}
mintFractionTokens :: ValidatorHash -> AssetClass -> Integer -> TokenName -> () -> ScriptContext -> Bool
mintFractionTokens fractionNFTScript asset@( AssetClass (nftCurrency, nftToken)) numberOfFractions fractionTokenName _ ctx =
let
info = scriptContextTxInfo ctx
mintedAmount = case flattenValue (txInfoMint info) of
[(cs, fractionTokenName', amt)] | cs == ownCurrencySymbol ctx && fractionTokenName' == fractionTokenName -> amt
_ -> 0
in
if mintedAmount > 0 then
let
nftValue = valueOf (valueSpent info) nftCurrency nftToken
assetIsLocked = nftValue == 1
lockedByNFTfractionScript = valueLockedBy info fractionNFTScript
assetIsPaid = assetClassValueOf lockedByNFTfractionScript asset == 1
in
traceIfFalse "NFT not paid" assetIsPaid &&
traceIfFalse "NFT not locked already" assetIsLocked &&
traceIfFalse "wrong fraction tokens minted" ( mintedAmount == numberOfFractions)
else
let
-- extract signer of this transaction, assume is only one
[sig] = txInfoSignatories info
assetIsReturned = assetClassValueOf (Validation.valuePaidTo info sig ) asset == 1
in
traceIfFalse "Asset not returned" assetIsReturned &&
traceIfFalse "wrong fraction tokens burned" ( mintedAmount == negate numberOfFractions)
mintFractionTokensPolicy :: AssetClass -> Integer -> TokenName -> Scripts.MintingPolicy
mintFractionTokensPolicy asset numberOfFractions fractionTokenName = mkMintingPolicyScript $
$$(PlutusTx.compile [|| \validator' asset' numberOfFractions' fractionTokenName' -> Scripts.wrapMintingPolicy $ mintFractionTokens validator' asset' numberOfFractions' fractionTokenName' ||])
`PlutusTx.applyCode`
PlutusTx.liftCode ( fractionNftValidatorHash asset)
`PlutusTx.applyCode`
PlutusTx.liftCode asset
`PlutusTx.applyCode`
PlutusTx.liftCode numberOfFractions
`PlutusTx.applyCode`
PlutusTx.liftCode fractionTokenName
curSymbol :: AssetClass -> Integer -> TokenName -> CurrencySymbol
curSymbol asset numberOfFractions fractionTokenName = scriptCurrencySymbol $ mintFractionTokensPolicy asset numberOfFractions fractionTokenName
data ToFraction = ToFraction
{ nftAsset :: !AssetClass
, fractions :: !Integer
, fractionTokenName :: !TokenName
} deriving (Generic, ToJSON, FromJSON, ToSchema)
type FracNFTSchema =
Endpoint "1-lockNFT" AssetClass
.\/ Endpoint "2-fractionNFT" ToFraction
.\/ Endpoint "3-returnNFT" AssetClass
-- | Extract Datum of a given transaction output is possible
extractData :: ChainIndexTxOut -> Maybe FractionNFTDatum
extractData o = do
Datum d <- either (const Nothing) Just (_ciTxOutDatum o)
PlutusTx.fromBuiltinData d
lockNFT :: AssetClass -> Contract w FracNFTSchema Text ()
lockNFT nftAsset = do
-- pay nft to contract
pk <- Contract.ownPubKey
let
-- keep the nft and asset class in the datum,
-- we signal no fractioning yet with a 0 in the total fractions field
datum =FractionNFTDatum{ tokensClass= nftAsset, totalFractions = 0, owner = pubKeyHash pk}
-- lock the nft and the datum into the fractioning contract
validator = fractionNftValidatorInstance nftAsset
tx = Constraints.mustPayToTheScript datum $ assetClassValue nftAsset 1
ledgerTx <- submitTxConstraints validator tx
void $ awaitTxConfirmed $ txId ledgerTx
Contract.logInfo @String $ printf "NFT locked"
fractionNFT :: ToFraction -> Contract w FracNFTSchema Text ()
fractionNFT ToFraction {nftAsset, fractions, fractionTokenName} = do
-- pay nft to contract
-- pay minted tokens back to signer
pkh <- pubKeyHash <$> Contract.ownPubKey
utxos <- utxosAt $ fractionNftValidatorAddress nftAsset
let
-- declare the NFT value
nftValue = assetClassValue nftAsset 1
-- find the UTxO that has the NFT we're looking for
Just utxo@(oref, _) = find (\(_,v) -> nftValue == txOutValue (toTxOut v)) $ Map.toList utxos
--find the minting script instance
mintingScript = mintFractionTokensPolicy nftAsset fractions fractionTokenName
-- define the value to mint (amount of tokens) and be paid to signer
currency = scriptCurrencySymbol mintingScript
tokensToMint = Value.singleton currency fractionTokenName fractions
payBackTokens = mustPayToPubKey pkh tokensToMint
-- value of NFT
valueToScript = assetClassValue nftAsset 1
-- keep the minted amount and asset class in the datum
--datum = Datum $ toBuiltinData FractionNFTDatum{ tokensClass= assetClass currency fractionTokenName, totalFractions = fractions, owner = pkh}
nftDatum = FractionNFTDatum{ tokensClass= assetClass currency fractionTokenName, totalFractions = fractions, owner = pkh}
nftData = toBuiltinData nftDatum
datum = Datum $ nftData
datumHash = txOutDatumHash $ txOutTxOut txout
--build the constraints and submit the transaction
validator = fractionValidatorScript nftAsset
lookups = Constraints.mintingPolicy mintingScript <>
Constraints.otherScript validator <>
Constraints.unspentOutputs ( Map.fromList [utxo] )
tx = Constraints.mustMintValue tokensToMint <>
Constraints.mustPayToOtherScript (fractionNftValidatorHash nftAsset) datum valueToScript <>
Constraints.mustSpendScriptOutput oref (Redeemer (toBuiltinData ())) <>
payBackTokens
ledgerTx <- submitTxConstraintsWith @Void lookups tx
void $ awaitTxConfirmed $ txId ledgerTx
Contract.logInfo @String $ printf "forged %s" (show fractions)
returnNFT :: AssetClass -> Contract w FracNFTSchema Text ()
returnNFT nftAsset = do
-- pay nft to signer
-- burn tokens
pk <- Contract.ownPubKey
utxos <- utxosAt $ fractionNftValidatorAddress nftAsset
let
-- declare the NFT value
valueToWallet = assetClassValue nftAsset 1
-- find the UTxO that has the NFT we're looking for
utxos' = Map.filter (\v -> valueToWallet == txOutValue (toTxOut v)) utxos
(nftRef,nftTx) = head $ Map.toList utxos'
-- use the auxiliary extractData function to get the datum content
Just FractionNFTDatum {tokensClass, totalFractions } = extractData nftTx
-- declare the fractional tokens to burn
(_, fractionTokenName) = unAssetClass tokensClass
tokensCurrency = curSymbol nftAsset totalFractions fractionTokenName
tokensToBurn = Value.singleton tokensCurrency fractionTokenName $ negate totalFractions
-- build the constraints and submit
validator = fractionValidatorScript nftAsset
lookups = Constraints.mintingPolicy (mintFractionTokensPolicy nftAsset totalFractions fractionTokenName) <>
Constraints.otherScript validator <>
Constraints.unspentOutputs utxos'
tx = Constraints.mustMintValue tokensToBurn <>
Constraints.mustSpendScriptOutput nftRef ( Redeemer $ toBuiltinData () ) <>
Constraints.mustPayToPubKey (pubKeyHash pk) valueToWallet
ledgerTx <- submitTxConstraintsWith @Void lookups tx
void $ awaitTxConfirmed $ txId ledgerTx
Contract.logInfo @String $ printf "burnt %s" (show totalFractions)
endpoints :: Contract () FracNFTSchema Text ()
endpoints = forever
$ handleError logError
$ awaitPromise
$ lock' `select` fractionNFT' `select` burn'
where
lock' = endpoint @"1-lockNFT" $ lockNFT
fractionNFT' = endpoint @"2-fractionNFT" $ fractionNFT
burn' = endpoint @"3-returnNFT" $ returnNFT
mkSchemaDefinitions ''FracNFTSchema
-- The code below is related to Playground.
-- NFT to lock "f"."nft2Lock"
nftSymbol :: CurrencySymbol
nftSymbol = currencySymbol "f"
-- ^ "f" = 66
nftName :: TokenName
nftName = TokenName "apartmentNft"
nft :: KnownCurrency
nft = KnownCurrency (fromSymbol nftSymbol) "Token" ( nftName :| [])
-- Fractional NFTs "".
-- The fraction NFT's cyrrency symbol is generated as a parameterized script from:
-- - the mintingScript with the following parameters
-- - the lockable nft's asset class
-- - the fraction value and the
-- - fraction nft's name
cs :: AssetClass -> Integer -> TokenName -> CurrencySymbol
cs asset numberOfFractions fractionTokenName = scriptCurrencySymbol $ mintFractionTokensPolicy asset numberOfFractions fractionTokenName
nftAssetClass :: AssetClass
nftAssetClass = Value.assetClass nftSymbol nftName
fraction :: Integer
fraction = 100
fractionNftName :: TokenName
fractionNftName = TokenName "fractionalToken"
fractionSymbol :: CurrencySymbol
fractionSymbol = curSymbol nftAssetClass fraction fractionNftName
fractionNfts :: KnownCurrency
fractionNfts = KnownCurrency (fromSymbol fractionSymbol) "Token" (fractionNftName :| [])
mkKnownCurrencies ['nft, 'fractionNfts]
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment