I just finish implementing the other approach we discussed here (with the two scripts), just tested it on the test net, and is working perfectly.
These are the two scripts:
Counter script
{-|
Module : Horrocubes.Counter.
Description : Plutus script that keeps track of an internal counter.
License : Apache-2.0
Maintainer : angel.castillo@horrocubes.io
Stability : experimental
This script keeps a counter and increases it every time the eUTXO is spent.
-}
-- LANGUAGE EXTENSIONS --------------------------------------------------------
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ViewPatterns #-}
-- MODULE DEFINITION ----------------------------------------------------------
module Horrocubes.Counter
(
counterScript,
counterScriptShortBs,
CounterParameter(..),
CounterDatum(..)
) where
-- IMPORTS --------------------------------------------------------------------
import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1)
import Codec.Serialise
import qualified Data.ByteString.Lazy as LBS
import qualified Data.ByteString.Short as SBS
import Ledger hiding (singleton)
import qualified Ledger.Typed.Scripts as Scripts
import Ledger.Value as Value
import qualified PlutusTx
import PlutusTx.Prelude as P hiding (Semigroup (..), unless)
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import qualified Ledger.Contexts as Validation
import Text.Show
import PlutusTx.Builtins
-- DATA TYPES -----------------------------------------------------------------
-- | The parameters for the counter contract.
data CounterParameter = CounterParameter {
cpOwnerPkh :: !PubKeyHash, -- ^ The transaction that spends this output must be signed by the private key
cpIdentityNft :: !AssetClass -- ^ The NFT that identifies the correct eUTXO.
} deriving (Show, Generic, FromJSON, ToJSON)
PlutusTx.makeLift ''CounterParameter
-- | The counter datum datatype.
data CounterDatum = CounterDatum {
cdValue :: !Integer, -- ^ The current counter value.
cdLimit :: !Integer -- ^ The value limit, after this limit is reached, this eUTXO can not be spent again.
} deriving (Show, Generic, FromJSON, ToJSON)
PlutusTx.unstableMakeIsData ''CounterDatum
-- | The Counter script type. Sets the Redeemer and Datum types for this script.
data Counter
instance Scripts.ValidatorTypes Counter where
type instance DatumType Counter = CounterDatum
type instance RedeemerType Counter = ()
-- DEFINITIONS ----------------------------------------------------------------
-- | Maybe gets the datum from the transatcion output.
{-# INLINABLE counterDatum #-}
counterDatum :: TxOut -> (DatumHash -> Maybe Datum) -> Maybe CounterDatum
counterDatum o f = do
dh <- txOutDatum o
Datum d <- f dh
PlutusTx.fromBuiltinData d
-- | Checks that the identity NFT is locked again in the contract.
{-# INLINABLE isIdentityNftRelocked #-}
isIdentityNftRelocked:: CounterParameter -> Value -> Bool
isIdentityNftRelocked params valueLockedByScript = assetClassValueOf valueLockedByScript (cpIdentityNft params) == 1
-- | Creates the validator script for the outputs on this contract.
{-# INLINABLE mkCounterValidator #-}
mkCounterValidator :: CounterParameter -> CounterDatum -> () -> ScriptContext -> Bool
mkCounterValidator parameters oldDatum _ ctx =
let isRightNexCounterValue = (newDatumIntegerValue == (oldDatumIntegerValue + 1))
isIdentityLocked = isIdentityNftRelocked parameters valueLockedByScript
isLimitTheSame = oldDatumLimitValue == newDatumLimitValue
isLimitNotReached = newDatumIntegerValue < newDatumLimitValue
in traceIfFalse "Wrong counter value" isRightNexCounterValue &&
traceIfFalse "Identity NFT missing" isIdentityLocked &&
traceIfFalse "Missing signature" isTransactionSignedByOwner &&
traceIfFalse "Limit value changed" isLimitTheSame &&
traceIfFalse "Limit reached" isLimitNotReached
where
info :: TxInfo
info = scriptContextTxInfo ctx
ownOutput :: TxOut
ownOutput = case getContinuingOutputs ctx of
[o] -> o
_ -> traceError "Expected exactly one output"
newDatum :: CounterDatum
newDatum = case counterDatum ownOutput (`findDatum` info) of
Nothing -> traceError "Counter output datum not found"
Just datum -> datum
oldDatumIntegerValue :: Integer
oldDatumIntegerValue = cdValue oldDatum
oldDatumLimitValue :: Integer
oldDatumLimitValue = cdLimit oldDatum
newDatumIntegerValue :: Integer
newDatumIntegerValue = cdValue newDatum
newDatumLimitValue :: Integer
newDatumLimitValue = cdLimit newDatum
valueLockedByScript :: Value
valueLockedByScript = Validation.valueLockedBy info (Validation.ownHash ctx)
isTransactionSignedByOwner :: Bool
isTransactionSignedByOwner = txSignedBy info (cpOwnerPkh parameters)
-- | The script instance of the counter. It contains the mkCounterValidator function
-- compiled to a Plutus core validator script.
counterInstance :: CounterParameter -> Scripts.TypedValidator Counter
counterInstance counter = Scripts.mkTypedValidator @Counter
($$(PlutusTx.compile [|| mkCounterValidator ||]) `PlutusTx.applyCode` PlutusTx.liftCode counter) $$(PlutusTx.compile [|| wrap ||])
where
wrap = Scripts.wrapValidator @CounterDatum @()
-- | Gets the counter validator script that matches the given parameters.
counterValidator :: CounterParameter -> Validator
counterValidator params = Scripts.validatorScript . counterInstance $ params
-- | Generates the plutus script.
counterPlutusScript :: CounterParameter -> Script
counterPlutusScript params = unValidatorScript $ counterValidator params
-- | Serializes the contract in CBOR format.
counterScriptShortBs :: CounterParameter -> SBS.ShortByteString
counterScriptShortBs params = SBS.toShort . LBS.toStrict $ serialise $ counterPlutusScript params
-- | Gets a serizlized plutus script from the given parameters.
counterScript :: PubKeyHash -> AssetClass -> PlutusScript PlutusScriptV1
counterScript pkh ac = PlutusScriptSerialised $ counterScriptShortBs $ CounterParameter { cpOwnerPkh = pkh, cpIdentityNft = ac }
The counter scripts trap an identity NFT inside (the only way to spend the output is to pay the NFT back to the script) and force the increment of the internal counter until it reaches a limit, the starting value of the counter and the limit are first defined when the output is first created.
Pre-conditions:
- The transaction spending this output must be signed with the proper key (passed as a script parameter)
- The identity NFT must be present (this is indirectly validated by the fact that the script check that the identity NFT is being paid to itself)
Post-Conditions:
- The field cdValue of the new datum must be equals to the field cdValue of the old datum plus 1 (value must be increased by exactly one)
- The field cdLimit of the new datum must equal to the field cdLimit of the old datum (value cant not be change between datums)
- The field cdValue of the new datum must be less than the value of the field cdLimit (once cdValue reach cdLimit the output can not be spent anymore)
- The identity NFT must be paid back to the original script
Minter script
{-|
Module : Horrocubes.MintingScriptWithCounter.
Description : Mint policy for NFTs.
License : Apache-2.0
Maintainer : angel.castillob@protonmail.com
Stability : experimental
This policy creates an NFT and uses an eUTXO with an internal counter to make the NFT truly unique.
-}
-- LANGUAGE EXTENSIONS --------------------------------------------------------
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE OverloadedStrings #-}
-- MODULE DEFINITION ----------------------------------------------------------
module Horrocubes.MintingScriptWithCounter
(
mintScript,
nftScriptShortBs
) where
-- IMPORTS --------------------------------------------------------------------
import Cardano.Api.Shelley (PlutusScript (..), PlutusScriptV1)
import Codec.Serialise
import qualified Data.ByteString.Lazy as LB
import qualified Data.ByteString.Short as SBS
import Ledger hiding (singleton)
import qualified Ledger.Typed.Scripts as Scripts
import Ledger.Value as Value
import qualified PlutusTx
import PlutusTx.Prelude hiding (Semigroup (..), unless)
import qualified Data.ByteString.Char8 as C
import PlutusTx.Builtins
import Horrocubes.Deserialisation
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import qualified Ledger.Contexts as Validation
import Text.Show
-- DATA TYPES -----------------------------------------------------------------
-- | The counter datum datatype.
data CounterDatum = CounterDatum {
cdValue :: !Integer, -- ^ The current counter value.
cdLimit :: !Integer -- ^ The value limit, after this limit is reached, this eUTXO can not be spent again.
} deriving (Show, Generic, FromJSON, ToJSON)
PlutusTx.unstableMakeIsData ''CounterDatum
-- DEFINITIONS ----------------------------------------------------------------
-- | Zero pads a given hex value to 8 cahracters.
{-# INLINABLE padLeft #-}
padLeft :: BuiltinByteString -> BuiltinByteString -> BuiltinByteString
padLeft charset bs = if lengthOfByteString bs < 8
then padLeft charset (consByteString (indexByteString charset 0) bs)
else bs
-- | Gets the Hash of the given UTXO.
{-# INLINABLE utxoHash #-}
utxoHash:: TxOutRef -> BuiltinByteString
utxoHash utxo = getTxId $ txOutRefId utxo
-- | Encodes an Integer into a diffent base (ie base 16).
{-# INLINABLE encodeBase #-}
encodeBase :: BuiltinByteString -> Integer -> BuiltinByteString
encodeBase charset value = encoded where
base = lengthOfByteString charset
encoded = expand (value `divMod` base) emptyByteString
lookup n = indexByteString charset n
expand (dividend, rem) xs
| (dividend > 0) = expand (dividend `divMod` base) result
| (dividend == 0 && rem > 0) = result
| (dividend == 0 && rem == 0) = xs
where result = consByteString (lookup rem) xs
-- | Creates the minting script for the NFT.
{-# INLINABLE mkNFTPolicy #-}
mkNFTPolicy :: BuiltinByteString -> PubKeyHash -> AssetClass -> BuiltinData -> ScriptContext -> Bool
mkNFTPolicy charset pkh identityNft _ ctx =
traceIfFalse "Identity NFT not found" isIdentityNftSpent &&
traceIfFalse "Invalid Postfix or wrong amount" checkMintedAmount &&
traceIfFalse "Missing signature" isTransactionSignedByOwner
where
info :: TxInfo
info = scriptContextTxInfo ctx
tokenNameToByteString :: TokenName -> BuiltinByteString
tokenNameToByteString tn = unTokenName tn
actuallPosfix :: BuiltinByteString -> BuiltinByteString
actuallPosfix tn = sliceByteString ((lengthOfByteString tn) - 8) 8 $ tn
expectedPosfix :: BuiltinByteString
expectedPosfix = padLeft charset $ encodeBase charset $ datumIntegerValue
isIdentityNftSpent :: Bool
isIdentityNftSpent = assetClassValueOf valueSpentByScript identityNft == 1
checkMintedAmount :: Bool
checkMintedAmount = case flattenValue (txInfoMint info) of
[(_, tn', amt)] -> (equalsByteString (actuallPosfix $ tokenNameToByteString tn') expectedPosfix) && amt == 1
_ -> False
valueSpentByScript :: Value
valueSpentByScript = Validation.valueSpent info
isTransactionSignedByOwner :: Bool
isTransactionSignedByOwner = txSignedBy info pkh
findUtxoWithIdentityNft :: TxOut
findUtxoWithIdentityNft = case filter (\(TxOut{txOutValue}) -> assetClassValueOf txOutValue identityNft == 1) (txInfoOutputs info) of
[o] -> o
_ -> traceError "Expected exactly one output"
stateDatum :: TxOut -> (DatumHash -> Maybe Datum) -> Maybe CounterDatum
stateDatum o f = do
dh <- txOutDatum o
Datum d <- f dh
PlutusTx.fromBuiltinData d
datumIntegerValue :: Integer
datumIntegerValue = case stateDatum findUtxoWithIdentityNft (`findDatum` info) of
Nothing -> traceError "Counter output datum not found"
Just datum -> cdValue datum
-- | Compiles the policy.
nftPolicy :: BuiltinByteString -> PubKeyHash -> AssetClass -> Scripts.MintingPolicy
nftPolicy charset pkh ac = mkMintingPolicyScript $
$$(PlutusTx.compile [|| \charset' pkh' ac' -> Scripts.wrapMintingPolicy $ mkNFTPolicy charset' pkh' ac'||])
`PlutusTx.applyCode`
PlutusTx.liftCode charset
`PlutusTx.applyCode`
PlutusTx.liftCode pkh
`PlutusTx.applyCode`
PlutusTx.liftCode ac
-- | Generates the plutus script.
nftPlutusScript :: BuiltinByteString -> PubKeyHash -> AssetClass -> Script
nftPlutusScript charset pkh ac = unMintingPolicyScript $ nftPolicy charset pkh ac
-- | Generates the NFT validator.
nftValidator :: BuiltinByteString -> PubKeyHash -> AssetClass -> Validator
nftValidator charset pkh ac = Validator $ nftPlutusScript charset pkh ac
-- | Serializes the contract in CBOR format.
nftScriptAsCbor :: BuiltinByteString -> PubKeyHash -> AssetClass -> LB.ByteString
nftScriptAsCbor charset pkh ac = serialise $ nftValidator charset pkh ac
-- | Serializes the contract in CBOR format.
nftScriptShortBs :: BuiltinByteString -> PubKeyHash -> AssetClass -> SBS.ShortByteString
nftScriptShortBs charset pkh ac = SBS.toShort . LB.toStrict $ nftScriptAsCbor charset pkh ac
-- | Gets a serizlize plutus script from the given UTXO and token name.
mintScript :: BuiltinByteString -> PubKeyHash -> AssetClass -> PlutusScript PlutusScriptV1
mintScript charset pkh ac = PlutusScriptSerialised . SBS.toShort . LB.toStrict $ nftScriptAsCbor charset pkh ac
This script only approves the minting transaction only if the identity NFT is present (the same one trapped in the counter eUTXO), the transaction is signed by the proper key (I think this could be removed as spending the counter eUTXO already requires this step), and then takes the datum from the output where the identity NFT is present, encodes it as a 32bit hex string and checks that the asset name of the new token being minted has this value as a postfix (last 8 characters must match this hex value).
Pre-conditions:
- The transaction minting the asset must be signed with the proper key (passed as a script parameter)
- The identity NFT must be present (the script checks that the identity NFT is being spent)
- The last 8 characters of the asset name of the token matches the hexadecimal representation of the counter (in 32bits)
Post-Conditions:
- Only one token with the right postfix value is being minted.
I already deployed this on the test net and it works, here is the address of the counter script:
addr_test1wz6g45e97dkqs3zxfptcmqt7lrssjjxg8aa389y5xyuwj3swtmgve
cardano-cli query utxo --address addr_test1wz6g45e97dkqs3zxfptcmqt7lrssjjxg8aa389y5xyuwj3swtmgve --testnet-magic 1097911063
TxHash TxIx Amount
--------------------------------------------------------------------------------------
4038e93e4cacbb98bfb8f7eaa5ca3cc0faf8630a432fbcad008b57065576f90c 1 2000000 lovelace + 1 06fa00b5ae593280e3d3a6693688523c85af4ff3033ddc8794ae311a.Horrocube00028 + TxOutDatumHash ScriptDataInAlonzoEra "a353f8598db438a37a4e9dd95587d93538b636e9f40b2b92e9537a4b37fd6731"
And this is the address of the wallet with the two minted tokens:
addr_test1vpfvmwfl8eucm8rnsej9pehzh7628k53raczagz4uvzzm2csx7sfl
cardano-cli query utxo --address addr_test1vpfvmwfl8eucm8rnsej9pehzh7628k53raczagz4uvzzm2csx7sfl --testnet-magic 1097911063
TxHash TxIx Amount
--------------------------------------------------------------------------------------
4038e93e4cacbb98bfb8f7eaa5ca3cc0faf8630a432fbcad008b57065576f90c 2 1413762 lovelace + 1 8bc230df616dedc8f35f61998a76c22bc516817d531c22d8b5025653.Horrocube00279c00000001 + TxOutDatumNo
ne
58407e484b6be51f6a4e7d5d8b3a792ece4345858ea90205789f1a9f5eac4c6a 0 4605885 lovelace + TxOutDatumNone
88391920ceb140791dc2da20d6b6aaed1ab78dd1c0e5cab255a48a9291aff558 0 207270848 lovelace + TxOutDatumNone
88391920ceb140791dc2da20d6b6aaed1ab78dd1c0e5cab255a48a9291aff558 2 1413762 lovelace + 1 8bc230df616dedc8f35f61998a76c22bc516817d531c22d8b5025653.Horrocube00279c00000002 + TxOutDatumNo
ne
b5aaf5fd5fa4da9ddac035620ae380ee0e5a6fa25eb6fb16685644eaa4d3f59e 0 9826887 lovelace + TxOutDatumNone
dc5a8bff48a9db6436559945ceb7a3f311045596407021312c133b1db70d7419 0 18659890 lovelace + TxOutDatumNone
f5d6b061ca29f9fcc8f0d7bac3b5eb8562568aeadb3cf797bfb8d33e64e1cc5a 0 110050044 lovelace + TxOutDatumNone
I think I would use this approach with a small change, right now the only inconvenient part of using this method is that it cant be used concurrently, as I must wait for the transaction to be added into a block so I can spend the new eUTXO, if I try to mint to fast I will end trying to double-spend the same output, to fix this what I was thinking was the following:
Instead of creating only one identity token, I create ten, using the same NFT factory but changing the value from 1 to 10, and lock all of them in different outputs with different starting values and using the limit to avoid overlapping, for example:
eUTXO 1: starting value 0, limit 1000
eUTXO 2: starting value 1000, limit 2000
eUTXO 3: starting value 2000, limit 3000
and so on (the validation on the script for the limit is not inclusive for the upper bound). this way I should always have available counters to use.
I would like to hear your opinion (@bwbush & @DinoDude) about the implementation, do you guys think it is safe enough?, I can’t see any flaw in the concept or the implementation.
If so, I will deploy it to the mainnet ASAP as my policy count keeps increasing rapidly.
PD: BTW @bwbush how did you manage to use ‘@’ in your token name? The CLI doesn’t allow me to use anything other than alphanumeric characters, I wanted to copy your convention xD.