77 lines
2.1 KiB
Haskell
77 lines
2.1 KiB
Haskell
{- |
|
|
Module : Agora.Stake.Scripts
|
|
Maintainer : emi@haskell.fyi
|
|
Description: Functions for dealing with generalized credentials.
|
|
|
|
Functions for dealing with generalized credentials.
|
|
-}
|
|
module Agora.Credential (
|
|
pauthorizedBy,
|
|
authorizationContext,
|
|
) where
|
|
|
|
import GHC.Records (HasField)
|
|
import Plutarch.Api.V1 (PCredential (PPubKeyCredential, PScriptCredential), PPubKeyHash)
|
|
import Plutarch.Api.V2 (PTxInInfo)
|
|
import Plutarch.Extra.ScriptContext (ptxSignedBy)
|
|
import Plutarch.Extra.TermCont (pmatchC)
|
|
|
|
{- | Context required in order to check 'AuthorizationCredential'.
|
|
|
|
Construct using 'authorizationContext'.
|
|
|
|
@since 1.0.0
|
|
-}
|
|
data PAuthorizationContext (s :: S) = PAuthorizationContext
|
|
{ signatories :: Term s (PBuiltinList (PAsData PPubKeyHash))
|
|
, inputs :: Term s (PBuiltinList PTxInInfo)
|
|
}
|
|
deriving stock
|
|
( -- | @since 1.0.0
|
|
Generic
|
|
)
|
|
deriving anyclass
|
|
( -- | @since 1.0.0
|
|
PlutusType
|
|
, -- | @since 1.0.0
|
|
PEq
|
|
)
|
|
|
|
-- | @since 1.0.0
|
|
instance DerivePlutusType PAuthorizationContext where
|
|
type DPTStrat _ = PlutusTypeScott
|
|
|
|
{- | Build up 'PAuthorizationContext' from fields.
|
|
|
|
@since 1.0.0
|
|
-}
|
|
authorizationContext ::
|
|
forall (s :: S) r.
|
|
( HasField "inputs" r (Term s (PBuiltinList PTxInInfo))
|
|
, HasField "signatories" r (Term s (PBuiltinList (PAsData PPubKeyHash)))
|
|
) =>
|
|
r ->
|
|
Term s PAuthorizationContext
|
|
authorizationContext f =
|
|
pcon (PAuthorizationContext f.signatories f.inputs)
|
|
|
|
{- | Check for authorization by credential.
|
|
|
|
@since 1.0.0
|
|
-}
|
|
pauthorizedBy :: forall (s :: S). Term s (PAuthorizationContext :--> PCredential :--> PBool)
|
|
pauthorizedBy = phoistAcyclic $
|
|
plam $ \ctx credential -> unTermCont $ do
|
|
ctxF <- pmatchC ctx
|
|
pure $
|
|
pmatch credential $ \case
|
|
PPubKeyCredential ((pfield @"_0" #) -> pk) ->
|
|
ptxSignedBy # ctxF.signatories # pk
|
|
PScriptCredential ((pfield @"_0" #) -> _) ->
|
|
pany
|
|
# plam
|
|
( \input ->
|
|
(pfield @"credential" #$ pfield @"address" #$ pfield @"resolved" # input)
|
|
#== credential
|
|
)
|
|
# ctxF.inputs
|