Expose PlutusV3-related functions

* Remove lenses `_PlutusScriptWitnessV1`, `_PlutusScriptWitnessV2`, `_PlutusScriptWitnessV3` * Add `_PlutusScriptWitness` lens
j-mueller · Dec 4, 2024 · a846476 · a846476
1 parent 563599c
commit a846476
Show file tree

Hide file tree

Showing 2 changed files with 44 additions and 25 deletions.
diff --git a/src/base/lib/Convex/PlutusLedger.hs b/src/base/lib/Convex/PlutusLedger.hs
@@ -50,8 +50,10 @@ module Convex.PlutusLedger(
   transAddressShelley,
 
   -- * Tx IDs
-  unTransTxOutRef,
-  transTxOutRef,
+  unTransTxOutRefV1,
+  transTxOutRefV1,
+  unTransTxOutRefV3,
+  transTxOutRefV3,
 
   -- * POSIX Time
   unTransPOSIXTime,
@@ -86,6 +88,7 @@ import qualified PlutusLedgerApi.V1.Scripts as P
 import qualified PlutusLedgerApi.V1.Value   as Value
 import qualified PlutusTx.AssocMap          as Map
 import qualified PlutusTx.Prelude           as PlutusTx
+import qualified PlutusLedgerApi.V3 as PV3
 
 -- | Translate a script hash from @cardano-api@ to @plutus@
 transScriptHash :: C.ScriptHash -> PV1.ScriptHash
@@ -212,16 +215,26 @@ unTransAddressShelley networkId (PV1.Address cred staking) =
     <$> unTransCredential cred
     <*> unTransStakeAddressReference staking
 
-unTransTxOutRef :: PV1.TxOutRef -> Either C.SerialiseAsRawBytesError C.TxIn
-unTransTxOutRef PV1.TxOutRef{PV1.txOutRefId=PV1.TxId bs, PV1.txOutRefIdx} =
+unTransTxOutRefV1 :: PV1.TxOutRef -> Either C.SerialiseAsRawBytesError C.TxIn
+unTransTxOutRefV1 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)
 
-transTxOutRef :: C.TxIn -> PV1.TxOutRef
-transTxOutRef (C.TxIn txId (C.TxIx ix)) =
+unTransTxOutRefV3 :: PV3.TxOutRef -> Either C.SerialiseAsRawBytesError C.TxIn
+unTransTxOutRefV3 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)
+
+transTxOutRefV1 :: C.TxIn -> PV1.TxOutRef
+transTxOutRefV1 (C.TxIn txId (C.TxIx ix)) =
   let i = PV1.TxId $ PlutusTx.toBuiltin $ C.serialiseToRawBytes txId
   in PV1.TxOutRef i (fromIntegral ix)
 
+transTxOutRefV3 :: C.TxIn -> PV3.TxOutRef
+transTxOutRefV3 (C.TxIn txId (C.TxIx ix)) =
+  let i = PV3.TxId $ PlutusTx.toBuiltin $ C.serialiseToRawBytes txId
+   in PV3.TxOutRef i (fromIntegral ix)
+
 transPOSIXTime :: POSIXTime -> PV1.POSIXTime
 transPOSIXTime posixTimeSeconds = PV1.POSIXTime (floor @Rational (1000 * realToFrac posixTimeSeconds))
 

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