Sulkta-Coop/agora
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Removed references to pindexdatalist in AuthorityToken

Browse source
This commit is contained in:
Jack Hodgkinson 2022-02-01 16:11:03 +00:00
parent ae03f77a23
commit 5e7233829f
2 changed files with 38 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Makefile
View file

@ -11,7 +11,7 @@ usage:
HOOGLE_PORT=8081
hoogle:
hoogle server --local --port $(HOOGLE_PORT)
hoogle server --local --port $(HOOGLE_PORT) > /dev/null &
FORMAT_EXTENSIONS := -o -XQuasiQuotes -o -XTemplateHaskell -o -XTypeApplications -o -XImportQualifiedPost -o -XPatternSynonyms -o -fplugin=RecordDotPreprocessor
format:

70
src/Agora/AuthorityToken.hs
View file

@ -1,8 +1,11 @@
module Agora.AuthorityToken (authorityTokenPolicy, AuthorityToken (..), serialisedScriptSize) where
module Agora.AuthorityToken (
authorityTokenPolicy,
AuthorityToken (..),
serialisedScriptSize,
) where
--------------------------------------------------------------------------------
import Data.Proxy (Proxy (..))
import Prelude
--------------------------------------------------------------------------------
@ -24,23 +27,17 @@ import Plutus.V1.Ledger.Value (AssetClass (..))
--------------------------------------------------------------------------------
import Plutarch.Api.V1 hiding (PMaybe (..))
import Plutarch.Bool (PBool, PEq, pif, (#<), (#==))
import Plutarch.Builtin (PBuiltinPair, PData, pdata, pfromData, pfstBuiltin, psndBuiltin)
import Plutarch.DataRepr.Internal.HList (IndexList)
import Plutarch.Integer (PInteger)
import Plutarch.Lift (pconstant)
import Plutarch.List (PIsListLike, pfoldr', precList)
import Plutarch.Maybe (PMaybe (PJust, PNothing))
import Plutarch.Api.V1
import Plutarch.List (pfoldr')
import Plutarch.Prelude
import Plutarch.Trace (ptraceError)
import Plutarch.Unit (PUnit)
--------------------------------------------------------------------------------
{- | An AuthorityToken represents a proof that a particular token moved while this token was minted.
In effect, this means that the validator that locked such a token must have approved said transaction.
Said validator should be made aware of _this_ token's existence in order to prevent incorrect minting.
{- | An AuthorityToken represents a proof that a particular token
moved while this token was minted. In effect, this means that
the validator that locked such a token must have approved
said transaction. Said validator should be made aware of
_this_ token's existence in order to prevent incorrect minting.
-}
data AuthorityToken = AuthorityToken
{ -- | Token that must move in order for minting this to be valid.
@ -49,18 +46,20 @@ data AuthorityToken = AuthorityToken
--------------------------------------------------------------------------------
pindexDataList :: Proxy n -> Term s (PDataList xs :--> PAsData (IndexList n xs))
pindexDataList = undefined
-- TODO: upstream something like this
pfind' :: PIsListLike list a => (Term s a -> Term s PBool) -> Term s (list a :--> PMaybe a)
pfind' ::
PIsListLike list a =>
(Term s a -> Term s PBool) ->
Term s (list a :--> PMaybe a)
pfind' p =
precList
(\self x xs -> pif (p x) (pcon (PJust x)) (self # xs))
(const $ pcon PNothing)
-- TODO: upstream something like this
plookup :: (PEq a, PIsListLike list (PBuiltinPair a b)) => Term s (a :--> list (PBuiltinPair a b) :--> PMaybe b)
plookup ::
(PEq a, PIsListLike list (PBuiltinPair a b)) =>
Term s (a :--> list (PBuiltinPair a b) :--> PMaybe b)
plookup =
phoistAcyclic $
plam $ \k xs ->
@ -72,7 +71,8 @@ passetClassValueOf' :: AssetClass -> Term s (PValue :--> PInteger)
passetClassValueOf' (AssetClass (sym, token)) =
passetClassValueOf # pconstant sym # pconstant token
passetClassValueOf :: Term s (PCurrencySymbol :--> PTokenName :--> PValue :--> PInteger)
passetClassValueOf ::
Term s (PCurrencySymbol :--> PTokenName :--> PValue :--> PInteger)
passetClassValueOf =
phoistAcyclic $
plam $ \sym token value'' ->
@ -86,7 +86,8 @@ passetClassValueOf =
PNothing -> 0
PJust v -> pfromData v
-- TODO: We should rely on plutus-extra instead of rolling our own, this is just quick & hacky.
-- TODO: We should rely on plutus-extra instead of rolling our own,
-- this is just quick and hacky.
serialisedScriptSize :: Script -> Int
serialisedScriptSize =
BSS.length
@ -96,26 +97,29 @@ serialisedScriptSize =
. BS.toStrict
. serialise
authorityTokenPolicy :: AuthorityToken -> Term s (PData :--> PData :--> PScriptContext :--> PUnit)
authorityTokenPolicy ::
AuthorityToken ->
Term s (PData :--> PData :--> PScriptContext :--> PUnit)
authorityTokenPolicy params =
plam $ \_datum _redeemer ctx' ->
pmatch ctx' $ \(PScriptContext ctx) ->
let txInfo' =
pfromData $ pindexDataList (Proxy @0) # ctx
purpose' =
pfromData $ pindexDataList (Proxy @1) # ctx
let txInfo' = pfromData $ pfield @"txInfo" # ctx
purpose' = pfromData $ pfield @"purpose" # ctx
inputs =
pmatch txInfo' $ \(PTxInfo txInfo) ->
pfromData $ pindexDataList (Proxy @0) # txInfo
pfromData $ pfield @"inputs" # txInfo
authorityTokenInputs =
pfoldr'
( \txInInfo' acc ->
pmatch (pfromData txInInfo') $ \(PTxInInfo txInInfo) ->
let txOut' = pfromData $ pindexDataList (Proxy @1) # txInInfo
txOutValue = pmatch txOut' $ \(PTxOut txOut) -> pfromData $ pindexDataList (Proxy @1) # txOut
let txOut' =
pfromData $ pfield @"resolved" # txInInfo
txOutValue =
pmatch txOut' $
\(PTxOut txOut) ->
pfromData $ pfield @"value" # txOut
in passetClassValueOf' params.authority # txOutValue + acc
)
# (0 :: Term s PInteger)
@ -124,12 +128,12 @@ authorityTokenPolicy params =
-- We incur the cost twice here. This will be fixed upstream in Plutarch.
mintedValue =
pmatch txInfo' $ \(PTxInfo txInfo) ->
pfromData $ pindexDataList (Proxy @3) # txInfo
pfromData $ pfield @"mint" # txInfo
tokenMoved = 0 #< authorityTokenInputs
in pmatch purpose' $ \case
PMinting sym' ->
let sym = pfromData $ pindexDataList (Proxy @0) # sym'
let sym = pfromData $ pfield @"_0" # sym'
mintedATs = passetClassValueOf # sym # pconstant "" # mintedValue
in pif
(0 #< mintedATs)