Expose PlutusV3-related functions (#244)

* Remove lenses `_PlutusScriptWitnessV1`, `_PlutusScriptWitnessV2`, `_PlutusScriptWitnessV3` * Add `_PlutusScriptWitness` lens * Replace Convex.PlutusLeger module with Convex.PlutusLedger.V1 * Add Convex.PlutusLedger.V3 module
j-mueller · Dec 5, 2024 · 134a3f1 · 134a3f1
1 parent 563599c
commit 134a3f1
Show file tree

Hide file tree

Showing 8 changed files with 58 additions and 27 deletions.
diff --git a/src/base/convex-base.cabal b/src/base/convex-base.cabal
@@ -36,7 +36,8 @@ library
       Convex.NodeQueries
       Convex.NodeQueries.Debug
       Convex.NodeParams
-      Convex.PlutusLedger
+      Convex.PlutusLedger.V1
+      Convex.PlutusLedger.V3
       Convex.PlutusTx
       Convex.Utils
       Convex.Utxos

diff --git a/src/base/lib/Convex/PlutusLedger.hs → src/base/lib/Convex/PlutusLedger/V1.hs b/src/base/lib/Convex/PlutusLedger.hs → src/base/lib/Convex/PlutusLedger/V1.hs
@@ -3,9 +3,9 @@
 {-# LANGUAGE NamedFieldPuns   #-}
 {-# LANGUAGE TupleSections    #-}
 {-# LANGUAGE TypeApplications #-}
-{-| Translating between cardano-api/cardano-ledger and plutus representations
+{-| Translating between cardano-api/cardano-ledger and plutus V1 representations
 -}
-module Convex.PlutusLedger(
+module Convex.PlutusLedger.V1 (
   -- * Script hashes
   transScriptHash,
   unTransScriptHash,
@@ -213,7 +213,7 @@ unTransAddressShelley networkId (PV1.Address cred staking) =
     <*> unTransStakeAddressReference staking
 
 unTransTxOutRef :: PV1.TxOutRef -> Either C.SerialiseAsRawBytesError C.TxIn
-unTransTxOutRef PV1.TxOutRef{PV1.txOutRefId=PV1.TxId bs, PV1.txOutRefIdx} =
+unTransTxOutRef PV1.TxOutRef{PV1.txOutRefId = PV1.TxId bs, PV1.txOutRefIdx} =
   let i = C.deserialiseFromRawBytes C.AsTxId $ PlutusTx.fromBuiltin bs
   in C.TxIn <$> i <*> pure (C.TxIx $ fromIntegral txOutRefIdx)
 
@@ -265,3 +265,4 @@ unTransScriptDataHash (P.DatumHash bs) =
 
 unTransTxOutDatumHash :: C.IsAlonzoBasedEra era => P.DatumHash -> Either C.SerialiseAsRawBytesError (C.TxOutDatum ctx era)
 unTransTxOutDatumHash datumHash = C.TxOutDatumHash C.alonzoBasedEra <$> unTransScriptDataHash datumHash
+
diff --git a/src/base/lib/Convex/PlutusLedger/V3.hs b/src/base/lib/Convex/PlutusLedger/V3.hs
@@ -0,0 +1,23 @@
+{-# LANGUAGE GADTs          #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-| Translating between cardano-api/cardano-ledger and plutus V3 representations
+-}
+module Convex.PlutusLedger.V3 (
+  -- * Tx IDs
+  unTransTxOutRef,
+  transTxOutRef,
+) where
+
+import qualified Cardano.Api.Shelley as C
+import qualified PlutusLedgerApi.V3  as PV3
+import qualified PlutusTx.Prelude    as PlutusTx
+
+unTransTxOutRef :: PV3.TxOutRef -> Either C.SerialiseAsRawBytesError C.TxIn
+unTransTxOutRef PV3.TxOutRef{PV3.txOutRefId = PV3.TxId bs, PV3.txOutRefIdx} =
+  let i = C.deserialiseFromRawBytes C.AsTxId $ PlutusTx.fromBuiltin bs
+  in C.TxIn <$> i <*> pure (C.TxIx $ fromIntegral txOutRefIdx)
+
+transTxOutRef :: C.TxIn -> PV3.TxOutRef
+transTxOutRef (C.TxIn txId (C.TxIx ix)) =
+  let i = PV3.TxId $ PlutusTx.toBuiltin $ C.serialiseToRawBytes txId
+  in PV3.TxOutRef i (fromIntegral ix)
diff --git a/src/base/lib/Convex/Utils.hs b/src/base/lib/Convex/Utils.hs
@@ -73,7 +73,7 @@ import           Control.Monad.Result                     (ResultT, throwError)
 import qualified Control.Monad.Result                     as Result
 import           Control.Monad.Trans.Except               (ExceptT, runExceptT)
 import           Convex.MonadLog                          (MonadLog, logWarnS)
-import           Convex.PlutusLedger                      (transPOSIXTime,
+import           Convex.PlutusLedger.V1                   (transPOSIXTime,
                                                            unTransPOSIXTime)
 import           Data.Aeson                               (Result (..),
                                                            fromJSON, object,

diff --git a/src/base/test/Convex/PlutusLedgerSpec.hs b/src/base/test/Convex/PlutusLedgerSpec.hs
@@ -5,7 +5,7 @@ module Convex.PlutusLedgerSpec where
 
 import qualified Cardano.Api.Ledger         as Shelley
 import qualified Cardano.Api.Shelley        as C
-import           Convex.PlutusLedger        (transAddressShelley,
+import           Convex.PlutusLedger.V1     (transAddressShelley,
                                              unTransAddressShelley)
 import qualified Test.Gen.Cardano.Api.Typed as CGen
 import qualified Test.QuickCheck            as QC

diff --git a/src/optics/lib/Convex/CardanoApi/Lenses.hs b/src/optics/lib/Convex/CardanoApi/Lenses.hs
@@ -65,8 +65,7 @@ module Convex.CardanoApi.Lenses(
   -- ** Witnesses
   _KeyWitness,
   _ScriptWitness,
-  _PlutusScriptWitnessV1,
-  _PlutusScriptWitnessV2,
+  _PlutusScriptWitness,
 
   -- ** Build tx
   _BuildTxWith,
@@ -559,23 +558,30 @@ _ScriptData = prism' from to where
   from :: a -> C.ScriptData
   from = Scripts.toScriptData
 
-_PlutusScriptWitnessV1 :: forall era witctx. Prism' (C.ScriptWitness witctx era) (C.ScriptLanguageInEra C.PlutusScriptV1 era, C.PlutusScriptVersion C.PlutusScriptV1, C.PlutusScriptOrReferenceInput C.PlutusScriptV1, C.ScriptDatum witctx, C.ScriptRedeemer, C.ExecutionUnits)
-_PlutusScriptWitnessV1 = prism' from to where
-  from :: (C.ScriptLanguageInEra C.PlutusScriptV1 era, C.PlutusScriptVersion C.PlutusScriptV1, C.PlutusScriptOrReferenceInput C.PlutusScriptV1, C.ScriptDatum witctx, C.ScriptRedeemer, C.ExecutionUnits) -> C.ScriptWitness witctx era
-  from (lang, v, i, dtr, red, ex) = C.PlutusScriptWitness lang v i dtr red ex
-
-  to :: C.ScriptWitness witctx era -> Maybe (C.ScriptLanguageInEra C.PlutusScriptV1 era, C.PlutusScriptVersion C.PlutusScriptV1, C.PlutusScriptOrReferenceInput C.PlutusScriptV1, C.ScriptDatum witctx, C.ScriptRedeemer, C.ExecutionUnits)
-  to (C.PlutusScriptWitness era C.PlutusScriptV1 i dtr red ex) = Just (era, C.PlutusScriptV1, i, dtr, red, ex)
-  to _ = Nothing
-
-_PlutusScriptWitnessV2 :: forall era witctx. Prism' (C.ScriptWitness witctx era) (C.ScriptLanguageInEra C.PlutusScriptV2 era, C.PlutusScriptVersion C.PlutusScriptV2, C.PlutusScriptOrReferenceInput C.PlutusScriptV2, C.ScriptDatum witctx, C.ScriptRedeemer, C.ExecutionUnits)
-_PlutusScriptWitnessV2 = prism' from to where
-  from :: (C.ScriptLanguageInEra C.PlutusScriptV2 era, C.PlutusScriptVersion C.PlutusScriptV2, C.PlutusScriptOrReferenceInput C.PlutusScriptV2, C.ScriptDatum witctx, C.ScriptRedeemer, C.ExecutionUnits) -> C.ScriptWitness witctx era
-  from (lang, v, i, dtr, red, ex) = C.PlutusScriptWitness lang v i dtr red ex
-
-  to :: C.ScriptWitness witctx era -> Maybe (C.ScriptLanguageInEra C.PlutusScriptV2 era, C.PlutusScriptVersion C.PlutusScriptV2, C.PlutusScriptOrReferenceInput C.PlutusScriptV2, C.ScriptDatum witctx, C.ScriptRedeemer, C.ExecutionUnits)
-  to (C.PlutusScriptWitness era C.PlutusScriptV2 i dtr red ex) = Just (era, C.PlutusScriptV2, i, dtr, red, ex)
-  to _ = Nothing
+_PlutusScriptWitness
+  :: forall era lang witctx.
+  C.PlutusScriptVersion lang
+  -> Prism'
+       (C.ScriptWitness witctx era)
+       ( C.ScriptLanguageInEra lang era
+       , C.PlutusScriptVersion lang
+       , C.PlutusScriptOrReferenceInput lang
+       , C.ScriptDatum witctx
+       , C.ScriptRedeemer
+       , C.ExecutionUnits
+       )
+_PlutusScriptWitness lang = prism' from (to lang) where
+  from :: (C.ScriptLanguageInEra lang era, C.PlutusScriptVersion lang, C.PlutusScriptOrReferenceInput lang, C.ScriptDatum witctx, C.ScriptRedeemer, C.ExecutionUnits) -> C.ScriptWitness witctx era
+  from (era, v, i, dtr, red, ex) = C.PlutusScriptWitness era v i dtr red ex
+
+  to :: C.PlutusScriptVersion lang -> C.ScriptWitness witctx era -> Maybe (C.ScriptLanguageInEra lang era, C.PlutusScriptVersion lang, C.PlutusScriptOrReferenceInput lang, C.ScriptDatum witctx, C.ScriptRedeemer, C.ExecutionUnits)
+  to C.PlutusScriptV1 (C.PlutusScriptWitness era C.PlutusScriptV1 i dtr red ex) = Just (era, lang, i, dtr, red, ex)
+  to C.PlutusScriptV2 (C.PlutusScriptWitness era C.PlutusScriptV2 i dtr red ex) = Just (era, lang, i, dtr, red, ex)
+  to C.PlutusScriptV3 (C.PlutusScriptWitness era C.PlutusScriptV3 i dtr red ex) = Just (era, lang, i, dtr, red, ex)
+  to C.PlutusScriptV1 (C.PlutusScriptWitness {}) = Nothing
+  to C.PlutusScriptV2 (C.PlutusScriptWitness {}) = Nothing
+  to C.PlutusScriptV3 (C.PlutusScriptWitness {}) = Nothing
+  to _ C.SimpleScriptWitness {} = Nothing
 
 _TxValidityNoLowerBound :: forall era. Prism' (C.TxValidityLowerBound era) ()
 _TxValidityNoLowerBound = prism' from to where

diff --git a/src/un-ada/lib/UnAda/OffChain/Scripts.hs b/src/un-ada/lib/UnAda/OffChain/Scripts.hs
@@ -18,7 +18,7 @@ import           Cardano.Api.Shelley         (AssetId (..), AssetName,
                                               PaymentCredential, PlutusScriptV2,
                                               PolicyId, Script)
 import qualified Cardano.Api.Shelley         as C
-import           Convex.PlutusLedger         (toMaryAssetName, transAssetName,
+import           Convex.PlutusLedger.V1      (toMaryAssetName, transAssetName,
                                               transPolicyId)
 import           Convex.Scripts              (compiledCodeToScript)
 import qualified Plutus.V1.Ledger.Api        as PV1

diff --git a/src/wallet/lib/Convex/Wallet/Operator.hs b/src/wallet/lib/Convex/Wallet/Operator.hs
@@ -40,7 +40,7 @@ import           Cardano.Api              (CtxTx, PaymentCredential, TxOut)
 import qualified Cardano.Api.Shelley      as C
 import           Convex.CardanoApi.Lenses (emptyTxOut)
 import           Convex.Class             (MonadBlockchain (queryNetworkId))
-import           Convex.PlutusLedger      (transPubKeyHash, transStakeKeyHash)
+import           Convex.PlutusLedger.V1   (transPubKeyHash, transStakeKeyHash)
 import           Convex.Utils             (readSigningKeyFromFile,
                                            readStakingKeyFromFile,
                                            readVerificationKeyFromFile)