Merge pull request #159 from Liqwid-Labs/connor/bump-stuff

Use latest version of Plutarch; Use upstreamed LPE utilities; Clean up some import/export lists

agora/Agora/Effect/GovernorMutation.hs

@@ -26,7 +26,6 @@ import Agora.Governor (
  )
 import Agora.Plutarch.Orphans ()
 import Agora.Scripts (AgoraScripts, authorityTokenSymbol, governorSTAssetClass)
-import Agora.Utils (pmustFindDatum)
 import Plutarch.Api.V1 (PValue)
 import Plutarch.Api.V2 (
   PTxOutRef,
@@ -39,7 +38,7 @@ import Plutarch.DataRepr (
 import Plutarch.Extra.Maybe (
   passertPJust,
  )
-import Plutarch.Extra.ScriptContext (pisScriptAddress)
+import Plutarch.Extra.ScriptContext (pfromOutputDatum, pisScriptAddress)
 import Plutarch.Extra.TermCont (pguardC, pletFieldsC)
 import Plutarch.Extra.Value (pvalueOf)
 import Plutarch.Lift (PConstantDecl, PLifted, PUnsafeLiftDecl)
@@ -201,7 +200,7 @@ mutateGovernorValidator as = makeEffect (authorityTokenSymbol as) $
 
     let governorOutputDatum =
           ptrace "Governor output datum not found" $
-            pmustFindDatum @PGovernorDatum # govOutput.datum # txInfoF.datums
+            pfromOutputDatum @PGovernorDatum # govOutput.datum # txInfoF.datums
 
     -- Ensure the output governor datum is what we want.
     pguardC "Unexpected governor datum" $ datumF.newDatum #== governorOutputDatum

agora/Agora/Effect/NoOp.hs

@@ -10,6 +10,7 @@ module Agora.Effect.NoOp (noOpValidator, PNoOp) where
 import Agora.Effect (makeEffect)
 import Agora.Plutarch.Orphans ()
 import Plutarch.Api.V2 (PValidator)
+import Plutarch.Orphans ()
 import PlutusLedgerApi.V1.Value (CurrencySymbol)
 
 {- | Dummy datum for NoOp effect.

agora/Agora/Governor/Scripts.hs

@@ -51,11 +51,6 @@ import Agora.Stake (
   pnumCreatedProposals,
  )
 import Agora.Utils (
-  pfindDatum,
-  pfromDatumHash,
-  pfstTuple,
-  pmustFindDatum,
-  psndTuple,
   validatorHashToAddress,
  )
 import Plutarch.Api.V1 (
@@ -81,11 +76,15 @@ import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
 import Plutarch.Extra.ScriptContext (
   pfindOutputsToAddress,
   pfindTxInByTxOutRef,
+  pfromDatumHash,
+  pfromOutputDatum,
   pisUTXOSpent,
   pscriptHashFromAddress,
+  ptryFromOutputDatum,
   pvalueSpent,
  )
 import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
+import Plutarch.Extra.Tuple (pfstTuple, psndTuple)
 import Plutarch.Extra.Value (phasOnlyOneTokenOfCurrencySymbol, psymbolValueOf)
 import PlutusLedgerApi.V1 (TxOutRef)
 
@@ -148,7 +147,7 @@ governorPolicy initialSpend =
           # pfromData txInfoF.outputs
 
     let outputDatum = pfield @"datum" # govOutput
-        datum = pmustFindDatum @PGovernorDatum # outputDatum # txInfoF.datums
+        datum = pfromOutputDatum @PGovernorDatum # outputDatum # txInfoF.datums
 
     pguardC "Governor output datum valid" $ pisGovernorDatumValid # datum
 
@@ -279,7 +278,7 @@ governorValidator as =
 
     -- Check that own output have datum of type 'GovernorDatum'.
     newGovernorDatum <-
-      pletC $ pmustFindDatum @PGovernorDatum # ownOutput.datum # txInfoF.datums
+      pletC $ pfromOutputDatum @PGovernorDatum # ownOutput.datum # txInfoF.datums
 
     pguardC "New datum is valid" $ pisGovernorDatumValid # newGovernorDatum
 
@@ -328,7 +327,7 @@ governorValidator as =
 
           stakeInputF <- pletFieldsC @'["datum", "value"] $ pfield @"resolved" # stakeInput
 
-          let stakeInputDatum = pmustFindDatum @(PAsData PStakeDatum) # stakeInputF.datum # txInfoF.datums
+          let stakeInputDatum = pfromOutputDatum @(PAsData PStakeDatum) # stakeInputF.datum # txInfoF.datums
 
           stakeInputDatumF <- pletAllC $ pto $ pfromData stakeInputDatum
 
@@ -358,7 +357,7 @@ governorValidator as =
 
           proposalOutputDatum' <-
             pletC $
-              pmustFindDatum @(PAsData PProposalDatum)
+              pfromOutputDatum @(PAsData PProposalDatum)
                 # (pfield @"datum" #$ phead # outputsToProposalValidatorWithStateToken)
                 # txInfoF.datums
 
@@ -404,7 +403,7 @@ governorValidator as =
                           pure $
                             pif
                               (psymbolValueOf # psstSymbol # txOutF.value #== 1)
-                              (pfindDatum @(PAsData PStakeDatum) # txOutF.datum # txInfoF.datums)
+                              (ptryFromOutputDatum @(PAsData PStakeDatum) # txOutF.datum # txInfoF.datums)
                               (pcon PNothing)
                       )
                     # pfromData txInfoF.outputs
@@ -452,7 +451,7 @@ governorValidator as =
                           ( psymbolValueOf # ppstSymbol # txOutF.value #== 1
                               #&& txOutF.address #== pdata pproposalValidatorAddress
                           )
-                          (pfindDatum @(PAsData PProposalDatum) # txOutF.datum # txInfoF.datums)
+                          (ptryFromOutputDatum @(PAsData PProposalDatum) # txOutF.datum # txInfoF.datums)
                           pnothing
                   )
                 # pfromData txInfoF.inputs

agora/Agora/Plutarch/Orphans.hs

@@ -1,54 +1,3 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 
-{- FIXME: All of the following instances and
-   types ought to belong in either plutarch or
-   plutarch-extra.
--}
-
 module Agora.Plutarch.Orphans () where
-
-import Plutarch.Api.V2 (PDatumHash (..), PScriptHash (..))
-import Plutarch.Builtin (PIsData (..))
-import Plutarch.Extra.TermCont (ptryFromC)
-import Plutarch.TryFrom (PTryFrom (..))
-import Plutarch.Unsafe (punsafeCoerce)
-
-newtype Flip f a b = Flip (f b a) deriving stock (Generic)
-
--- | @since 0.1.0
-instance PTryFrom PData (PAsData PDatumHash) where
-  type PTryFromExcess PData (PAsData PDatumHash) = Flip Term PDatumHash
-  ptryFrom' opq = runTermCont $ do
-    (pfromData -> unwrapped, _) <- ptryFromC @(PAsData PByteString) opq
-
-    tcont $ \f ->
-      pif
-        -- Blake2b_256 hash: 256 bits/32 bytes.
-        (plengthBS # unwrapped #== 32)
-        (f ())
-        (ptraceError "ptryFrom(PDatumHash): must be 32 bytes long")
-
-    pure (punsafeCoerce opq, pcon $ PDatumHash unwrapped)
-
--- | @since 0.2.0
-instance PTryFrom PData (PAsData PUnit)
-
--- | @since 0.2.0
-instance (PIsData a) => PIsData (PAsData a) where
-  pfromDataImpl = punsafeCoerce
-  pdataImpl = pdataImpl . pfromData
-
--- | @since 1.0.0
-instance PTryFrom PData (PAsData PScriptHash) where
-  type PTryFromExcess PData (PAsData PScriptHash) = Flip Term PScriptHash
-  ptryFrom' opq = runTermCont $ do
-    (pfromData -> unwrapped, _) <- ptryFromC @(PAsData PByteString) opq
-
-    tcont $ \f ->
-      pif
-        -- Blake2b_224 hash: 224 bits/28 bytes.
-        (plengthBS # unwrapped #== 28)
-        (f ())
-        (ptraceError "ptryFrom(PScriptHash): must be 32 bytes long")
-
-    pure (punsafeCoerce opq, pcon $ PScriptHash unwrapped)

agora/Agora/Proposal.hs

@@ -83,8 +83,8 @@ import Plutarch.Lift (
   PConstantDecl,
   PUnsafeLiftDecl (..),
  )
+import Plutarch.Orphans ()
 import Plutarch.SafeMoney (PDiscrete (..))
-import Plutarch.Show (PShow (..))
 import PlutusLedgerApi.V2 (Credential, DatumHash, ScriptHash, ValidatorHash)
 import PlutusTx qualified
 import PlutusTx.AssocMap qualified as AssocMap

agora/Agora/Proposal/Scripts.hs

@@ -38,10 +38,7 @@ import Agora.Stake (
   pisVoter,
  )
 import Agora.Utils (
-  pfromDatumHash,
   pltAsData,
-  pmustFindDatum,
-  ptryFindDatum,
  )
 import Plutarch.Api.V2 (
   PDatumHash,
@@ -62,7 +59,10 @@ import Plutarch.Extra.Maybe (passertPJust, pfromJust, pisJust)
 import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
 import Plutarch.Extra.ScriptContext (
   pfindTxInByTxOutRef,
+  pfromDatumHash,
+  pfromOutputDatum,
   pisTokenSpent,
+  ptryFindDatum,
  )
 import Plutarch.Extra.TermCont (
   pguardC,
@@ -213,7 +213,7 @@ proposalValidator as maximumCosigners =
                 --       Maybe we can cache the sorted datum map?
                 let datum =
                       pfromData $
-                        pmustFindDatum @(PAsData PProposalDatum)
+                        pfromOutputDatum @(PAsData PProposalDatum)
                           # inputF.datum
                           # txInfoF.datums
 
@@ -229,7 +229,7 @@ proposalValidator as maximumCosigners =
     proposalOut <-
       pletC $
         pfromData $
-          pmustFindDatum @(PAsData PProposalDatum)
+          pfromOutputDatum @(PAsData PProposalDatum)
             # (pfield @"datum" # ownOutput)
             # txInfoF.datums
 

agora/Agora/Stake.hs

@@ -50,8 +50,8 @@ import Plutarch.Extra.List (pnotNull)
 import Plutarch.Extra.Sum (PSum (..))
 import Plutarch.Extra.Traversable (pfoldMap)
 import Plutarch.Lift (PConstantDecl, PUnsafeLiftDecl (..))
+import Plutarch.Orphans ()
 import Plutarch.SafeMoney (PDiscrete)
-import Plutarch.Show (PShow (..))
 import PlutusLedgerApi.V1 (Credential)
 import PlutusTx qualified
 import Prelude hiding (Num (..))
@@ -328,6 +328,8 @@ data PProposalLock (s :: S)
       PIsData
     , -- | @since 0.1.0
       PEq
+    , -- | @since 0.2.0
+      PShow
     )
 
 instance DerivePlutusType PProposalLock where
@@ -349,15 +351,6 @@ deriving via
   instance
     (Plutarch.Lift.PConstantDecl ProposalLock)
 
--- | @since 0.2.0
-instance PShow PProposalLock where
-  pshow' :: Bool -> Term s PProposalLock -> Term s PString
-  pshow' True x = "(" <> pshow' False x <> ")"
-  pshow' False lock = pmatch lock $ \case
-    PCreated ((pfield @"created" #) -> pid) -> "PCreated " <> pshow' True pid
-    PVoted x -> pletFields @'["votedOn", "votedFor"] x $ \xF ->
-      "PVoted " <> pshow' True xF.votedOn <> " " <> pshow' True xF.votedFor
-
 --------------------------------------------------------------------------------
 
 {- | Check whether a Stake is locked. If it is locked, various actions are unavailable.

agora/Agora/Stake/Scripts.hs

@@ -16,10 +16,6 @@ import Agora.Stake (
   StakeRedeemer (WitnessStake),
   pstakeLocked,
  )
-import Agora.Utils (
-  pfromDatumHash,
-  pmustFindDatum,
- )
 import Data.Function (on)
 import Data.Tagged (Tagged (..), untag)
 import Plutarch.Api.V1 (
@@ -45,7 +41,12 @@ import Plutarch.Extra.Field (pletAllC)
 import Plutarch.Extra.List (pmapMaybe, pmsortBy)
 import Plutarch.Extra.Maybe (passertPJust, pdjust, pdnothing, pmaybeData)
 import Plutarch.Extra.Record (mkRecordConstr, (.&), (.=))
-import Plutarch.Extra.ScriptContext (pfindTxInByTxOutRef, pvalueSpent)
+import Plutarch.Extra.ScriptContext (
+  pfindTxInByTxOutRef,
+  pfromDatumHash,
+  pfromOutputDatum,
+  pvalueSpent,
+ )
 import Plutarch.Extra.TermCont (pguardC, pletC, pletFieldsC, pmatchC, ptryFromC)
 import Plutarch.Extra.Value (
   pgeqByClass',
@@ -114,7 +115,7 @@ stakePolicy gtClassRef =
                         (psymbolValueOf # ownSymbol # txOutF.value #== 1)
                         ( let datum =
                                 pfromData $
-                                  pmustFindDatum @(PAsData PStakeDatum)
+                                  pfromOutputDatum @(PAsData PStakeDatum)
                                     # txOutF.datum
                                     # txInfoF.datums
                            in pnot # (pstakeLocked # datum)
@@ -158,7 +159,7 @@ stakePolicy gtClassRef =
                 pletFieldsC @'["owner", "stakedAmount"] $
                   pto $
                     pfromData $
-                      pmustFindDatum @(PAsData PStakeDatum) # outputF.datum # txInfoF.datums
+                      pfromOutputDatum @(PAsData PStakeDatum) # outputF.datum # txInfoF.datums
 
               let hasExpectedStake =
                     ptraceIfFalse "Stake ouput has expected amount of stake token" $
@@ -378,7 +379,7 @@ stakeValidator as gtClassRef =
                 stakeOut <-
                   pletC $
                     pfromData $
-                      pmustFindDatum @(PAsData PStakeDatum)
+                      pfromOutputDatum @(PAsData PStakeDatum)
                         # (pfield @"datum" # ownOutput)
                         # txInfoF.datums
 

agora/Agora/Treasury.hs

@@ -8,7 +8,11 @@ Description: Treasury scripts.
 Contains the datum, redeemer and validator for a template DAO
 treasury.
 -}
-module Agora.Treasury (module Agora.Treasury) where
+module Agora.Treasury (
+  TreasuryRedeemer (..),
+  PTreasuryRedeemer (..),
+  treasuryValidator,
+) where
 
 import Agora.AuthorityToken (singleAuthorityTokenBurned)
 import Generics.SOP qualified as SOP

agora/Agora/Utils.hs

@@ -16,28 +16,8 @@ module Agora.Utils (
   CompiledValidator (..),
   CompiledMintingPolicy (..),
   CompiledEffect (..),
-  presolveOutputDatum,
-  pfindDatum,
-  pmustFindDatum,
-  (#.*),
-  (#.**),
-  pfromDatumHash,
-  pfromInlineDatum,
-  ptryFindDatum,
-  pfstTuple,
-  psndTuple,
 ) where
 
-import Plutarch.Api.V1.AssocMap (KeyGuarantees (Unsorted), PMap)
-import Plutarch.Api.V1.AssocMap qualified as PAssocMap
-import Plutarch.Api.V2 (
-  PDatum,
-  PDatumHash,
-  POutputDatum (..),
-  PTuple,
- )
-import Plutarch.Extra.Functor (pfmap)
-import Plutarch.Extra.Maybe (passertPJust, pjust, pnothing)
 import PlutusLedgerApi.V2 (
   Address (..),
   Credential (..),
@@ -118,137 +98,3 @@ newtype CompiledMintingPolicy (redeemer :: Type) = CompiledMintingPolicy
 newtype CompiledEffect (datum :: Type) = CompiledEffect
   { getCompiledEffect :: Validator
   }
-
--- @since 1.0.0
-presolveOutputDatum ::
-  forall s.
-  Term
-    s
-    ( POutputDatum
-        :--> PMap 'Unsorted PDatumHash PDatum
-        :--> PMaybe PDatum
-    )
-presolveOutputDatum = phoistAcyclic $
-  plam $ \od m -> pmatch od $ \case
-    PNoOutputDatum _ ->
-      ptrace "no datum" pnothing
-    POutputDatum ((pfield @"outputDatum" #) -> datum) ->
-      ptrace "datum hash" pjust # datum
-    POutputDatumHash ((pfield @"datumHash" #) -> hash) ->
-      PAssocMap.plookup
-        # hash
-        # m
-
--- | @since 1.0.0
-pfindDatum ::
-  forall datum s.
-  PTryFrom PData datum =>
-  Term
-    s
-    ( POutputDatum
-        :--> PMap 'Unsorted PDatumHash PDatum
-        :--> PMaybe datum
-    )
-pfindDatum = phoistAcyclic $
-  plam $ \od m ->
-    pfmap
-      # phoistAcyclic (plam $ flip ptryFrom fst . pto)
-      # (presolveOutputDatum # od # m)
-
--- | @since 1.0.0
-pmustFindDatum ::
-  forall datum s.
-  (PIsData datum, PTryFrom PData datum) =>
-  Term
-    s
-    ( POutputDatum
-        :--> PMap 'Unsorted PDatumHash PDatum
-        :--> datum
-    )
-pmustFindDatum =
-  phoistAcyclic $
-    plam $
-      (passertPJust # "datum not found") #.* pfindDatum
-
--- | @since 1.0.0
-pfromDatumHash :: forall s. Term s (POutputDatum :--> PDatumHash)
-pfromDatumHash = phoistAcyclic $
-  plam $
-    flip pmatch $ \case
-      POutputDatumHash ((pfield @"datumHash" #) -> hash) -> hash
-      _ -> ptraceError "not a datum hash"
-
--- | @since 1.0.0
-pfromInlineDatum :: forall s. Term s (POutputDatum :--> PDatum)
-pfromInlineDatum = phoistAcyclic $
-  plam $
-    flip pmatch $ \case
-      POutputDatum ((pfield @"outputDatum" #) -> datum) -> datum
-      _ -> ptraceError "not an inline datum"
-
-{- | Find a datum with the given hash, and 'ptryFrom' it.
-
-     @since 1.0.0
--}
-ptryFindDatum ::
-  forall datum (s :: S).
-  PTryFrom PData datum =>
-  Term
-    s
-    ( PDatumHash
-        :--> PMap 'Unsorted PDatumHash PDatum
-        :--> PMaybe datum
-    )
-ptryFindDatum =
-  phoistAcyclic $
-    plam $
-      (pfmap # ptryFromDatum)
-        #.* PAssocMap.plookup
-
-{- | Convert a 'PDatum' to the given datum type.
-
-     @since 1.0.0
--}
-ptryFromDatum ::
-  forall datum s.
-  (PTryFrom PData datum) =>
-  Term s (PDatum :--> datum)
-ptryFromDatum = phoistAcyclic $ plam $ flip ptryFrom fst . pto
-
-infixr 8 #.*
-infixr 8 #.**
-
--- | @since 1.0.0
-(#.*) ::
-  forall d c b a s.
-  Term s (c :--> d) ->
-  Term s (a :--> b :--> c) ->
-  Term s a ->
-  Term s b ->
-  Term s d
-(#.*) f g x y = f #$ g # x # y
-
--- | @since 1.0.0
-(#.**) ::
-  forall e d c b a s.
-  Term s (d :--> e) ->
-  Term s (a :--> b :--> c :--> d) ->
-  Term s a ->
-  Term s b ->
-  Term s c ->
-  Term s e
-(#.**) f g x y z = f #$ g # x # y # z
-
-{- | Extract the first component of a 'PTuple'.
-
-     @since 1.0.0
--}
-pfstTuple :: forall a b s. (PIsData a) => Term s (PTuple a b :--> a)
-pfstTuple = phoistAcyclic $ plam $ pfromData . (pfield @"_0" #)
-
-{- | Extract the second component of a 'PTuple'.
-
-     @since 1.0.0
--}
-psndTuple :: forall b a s. (PIsData b) => Term s (PTuple a b :--> b)
-psndTuple = phoistAcyclic $ plam $ pfromData . (pfield @"_1" #)