content: {- |
  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 "liqwid-plutarch-extra" 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 :: Type).
    ( 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
  