diff --git a/src/base/lib/Convex/PlutusLedger.hs b/src/base/lib/Convex/PlutusLedger.hs index 5d5ba980..908ad4b4 100644 --- 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 index 685d4e70..de418c41 100644 --- 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