153 lines
4.5 KiB
Haskell
153 lines
4.5 KiB
Haskell
{-# LANGUAGE QuasiQuotes #-}
|
|
|
|
{- |
|
|
Module : Spec.AuthorityToken
|
|
Maintainer : emi@haskell.fyi
|
|
Description: Tests for Authority token functions
|
|
|
|
Tests for Authority token functions
|
|
-}
|
|
module Spec.AuthorityToken (specs) where
|
|
|
|
import Agora.AuthorityToken (singleAuthorityTokenBurned)
|
|
import Plutarch (ClosedTerm, POpaque, perror, popaque)
|
|
import Plutarch.Extra.Compile (mustCompile)
|
|
import Plutarch.Unsafe (punsafeCoerce)
|
|
import PlutusLedgerApi.V1 (
|
|
Address (Address),
|
|
Credential (PubKeyCredential, ScriptCredential),
|
|
CurrencySymbol,
|
|
Script,
|
|
TxInInfo (TxInInfo),
|
|
TxOut (TxOut),
|
|
TxOutRef (TxOutRef),
|
|
ValidatorHash (ValidatorHash),
|
|
Value,
|
|
)
|
|
import PlutusLedgerApi.V1.Value qualified as Value (
|
|
Value (Value),
|
|
singleton,
|
|
)
|
|
import PlutusTx.AssocMap qualified as AssocMap (empty)
|
|
import Test.Specification (
|
|
SpecificationTree,
|
|
group,
|
|
scriptFails,
|
|
scriptSucceeds,
|
|
)
|
|
import Prelude (
|
|
Maybe (Nothing),
|
|
PBool,
|
|
Semigroup ((<>)),
|
|
fmap,
|
|
pconstant,
|
|
pif,
|
|
($),
|
|
)
|
|
|
|
currencySymbol :: CurrencySymbol
|
|
currencySymbol = "deadbeef"
|
|
|
|
mkInputs :: [TxOut] -> [TxInInfo]
|
|
mkInputs = fmap (TxInInfo (TxOutRef "" 0))
|
|
|
|
singleAuthorityTokenBurnedTest :: Value -> [TxOut] -> Script
|
|
singleAuthorityTokenBurnedTest mint outs =
|
|
let actual :: ClosedTerm PBool
|
|
actual = singleAuthorityTokenBurned (pconstant currencySymbol) (punsafeCoerce $ pconstant $ mkInputs outs) (pconstant mint)
|
|
s :: ClosedTerm POpaque
|
|
s =
|
|
pif
|
|
actual
|
|
(popaque (pconstant ()))
|
|
perror
|
|
in mustCompile s
|
|
|
|
-- | The SpecificationTree exported by this module.
|
|
specs :: [SpecificationTree]
|
|
specs =
|
|
[ -- This is better suited for plutarch-test
|
|
group
|
|
"singleAuthorityTokenBurned"
|
|
[ scriptSucceeds
|
|
"Correct simple"
|
|
( singleAuthorityTokenBurnedTest
|
|
( Value.singleton currencySymbol "deadbeef" (-1)
|
|
<> Value.singleton "aa" "USDC" 100_000
|
|
)
|
|
[ TxOut
|
|
(Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing)
|
|
(Value.singleton currencySymbol "deadbeef" 1)
|
|
Nothing
|
|
]
|
|
)
|
|
, scriptSucceeds
|
|
"Correct many inputs"
|
|
( singleAuthorityTokenBurnedTest
|
|
( Value.singleton currencySymbol "deadbeef" (-1)
|
|
<> Value.singleton "aa" "USDC" 100_000
|
|
)
|
|
[ TxOut
|
|
(Address (PubKeyCredential "") Nothing)
|
|
(Value.singleton "aaabcc" "hello-token" 1)
|
|
Nothing
|
|
, TxOut
|
|
(Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing)
|
|
(Value.singleton currencySymbol "deadbeef" 1)
|
|
Nothing
|
|
, TxOut
|
|
(Address (PubKeyCredential "") Nothing)
|
|
(Value.singleton "" "" 1_000_000_000)
|
|
Nothing
|
|
]
|
|
)
|
|
, scriptFails
|
|
"Incorrect no burn"
|
|
( singleAuthorityTokenBurnedTest
|
|
( Value.Value AssocMap.empty
|
|
)
|
|
[]
|
|
)
|
|
, scriptFails
|
|
"Incorrect no GAT burn"
|
|
( singleAuthorityTokenBurnedTest
|
|
( Value.singleton "aabbcc" "not a GAT!" (-100)
|
|
)
|
|
[]
|
|
)
|
|
, scriptFails
|
|
"Incorrect script mismatch"
|
|
( singleAuthorityTokenBurnedTest
|
|
( Value.singleton currencySymbol "i'm not deadbeef!" (-1)
|
|
)
|
|
[ TxOut
|
|
(Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing)
|
|
(Value.singleton currencySymbol "i'm not deadbeef!" 1)
|
|
Nothing
|
|
]
|
|
)
|
|
, scriptFails
|
|
"Incorrect spent from PK"
|
|
( singleAuthorityTokenBurnedTest
|
|
( Value.singleton currencySymbol "doesn't matter" (-1)
|
|
)
|
|
[ TxOut
|
|
(Address (PubKeyCredential "") Nothing)
|
|
(Value.singleton currencySymbol "doesn't matter" 1)
|
|
Nothing
|
|
]
|
|
)
|
|
, scriptFails
|
|
"Incorrect two GATs"
|
|
( singleAuthorityTokenBurnedTest
|
|
( Value.singleton currencySymbol "deadbeef" (-2)
|
|
<> Value.singleton "aa" "USDC" 100_000
|
|
)
|
|
[ TxOut
|
|
(Address (ScriptCredential (ValidatorHash "deadbeef")) Nothing)
|
|
(Value.singleton currencySymbol "deadbeef" 2)
|
|
Nothing
|
|
]
|
|
)
|
|
]
|
|
]
|