From ab547ed82fb35c75821c1a476c92f4675d8cec2f Mon Sep 17 00:00:00 2001
From: Koz Ross <koz.ross@retro-freedom.nz>
Date: Tue, 2 Jul 2024 14:02:25 +1200
Subject: [PATCH 1/4] Fix PTxOut sortedness bug

---
 plutarch-ledger-api/plutarch-ledger-api.cabal |  5 +-
 .../src/Plutarch/LedgerApi/Contexts.hs        |  8 +-
 .../src/Plutarch/LedgerApi/Tx.hs              |  2 +-
 plutarch-ledger-api/test/Main.hs              | 86 +++++++++++++++++++
 .../src/PlutusLedgerApi/V1/Orphans/Value.hs   | 15 +++-
 5 files changed, 106 insertions(+), 10 deletions(-)

diff --git a/plutarch-ledger-api/plutarch-ledger-api.cabal b/plutarch-ledger-api/plutarch-ledger-api.cabal
index 6784fdc26..d2c2cfb9f 100644
--- a/plutarch-ledger-api/plutarch-ledger-api.cabal
+++ b/plutarch-ledger-api/plutarch-ledger-api.cabal
@@ -87,5 +87,8 @@ test-suite tests
   import:         test-lang
   type:           exitcode-stdio-1.0
   main-is:        Main.hs
-  build-depends:  plutarch-orphanage
+  build-depends:
+    , plutarch-orphanage
+    , prettyprinter
+
   hs-source-dirs: test
diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/Contexts.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/Contexts.hs
index 7437de00e..6e5bbb004 100644
--- a/plutarch-ledger-api/src/Plutarch/LedgerApi/Contexts.hs
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/Contexts.hs
@@ -43,7 +43,7 @@ import Plutarch.DataRepr (
   PDataFields,
  )
 import Plutarch.LedgerApi.AssocMap qualified as AssocMap
-import Plutarch.LedgerApi.Credential (PCredential, PStakingCredential)
+import Plutarch.LedgerApi.Credential (PCredential)
 import Plutarch.LedgerApi.Crypto (PPubKeyHash)
 import Plutarch.LedgerApi.Interval qualified as Interval
 import Plutarch.LedgerApi.Scripts (
@@ -253,7 +253,7 @@ instance PTryFrom PData (PAsData PDelegatee)
 
 -- | @since 3.1.0
 data PTxCert (s :: S)
-  = PTxCertRegStaking (Term s (PDataRecord '["_0" ':= PCredential, "_1" ':= PMaybeData Value.PCurrencySymbol]))
+  = PTxCertRegStaking (Term s (PDataRecord '["_0" ':= PCredential, "_1" ':= PMaybeData Value.PLovelace]))
   | PTxCertUnRegStaking (Term s (PDataRecord '["_0" ':= PCredential, "_1" ':= PMaybeData Value.PLovelace]))
   | PTxCertDelegStaking (Term s (PDataRecord '["_0" ':= PCredential, "_1" ':= PDelegatee]))
   | PTxCertRegDeleg (Term s (PDataRecord '["_0" ':= PCredential, "_1" ':= PDelegatee, "_2" ':= Value.PLovelace]))
@@ -826,10 +826,10 @@ newtype PTxInfo (s :: S)
               '[ "inputs" ':= PBuiltinList (PAsData PTxInInfo)
                , "referenceInputs" ':= PBuiltinList (PAsData PTxInInfo)
                , "outputs" ':= PBuiltinList (PAsData PTxOut)
-               , "fee" ':= Value.PValue 'AssocMap.Sorted 'Value.Positive
+               , "fee" ':= Value.PLovelace
                , "mint" ':= Value.PValue 'AssocMap.Sorted 'Value.NonZero -- value minted by transaction
                , "txCerts" ':= PBuiltinList (PAsData PTxCert)
-               , "wdrl" ':= AssocMap.PMap 'AssocMap.Unsorted PStakingCredential PInteger -- Staking withdrawals
+               , "wdrl" ':= AssocMap.PMap 'AssocMap.Unsorted PCredential Value.PLovelace -- Staking withdrawals
                , "validRange" ':= Interval.PInterval PPosixTime
                , "signatories" ':= PBuiltinList (PAsData PPubKeyHash)
                , "redeemers" ':= AssocMap.PMap 'AssocMap.Unsorted PScriptPurpose PRedeemer
diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/Tx.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/Tx.hs
index 80af24f6a..11d9d4272 100644
--- a/plutarch-ledger-api/src/Plutarch/LedgerApi/Tx.hs
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/Tx.hs
@@ -152,7 +152,7 @@ newtype PTxOut (s :: S)
           s
           ( PDataRecord
               '[ "address" ':= PAddress
-               , "value" ':= Value.PValue 'AssocMap.Sorted 'Value.Positive
+               , "value" ':= Value.PValue 'AssocMap.Sorted 'Value.NoGuarantees
                , "datum" ':= POutputDatum
                , "referenceScript" ':= PMaybeData PScriptHash
                ]
diff --git a/plutarch-ledger-api/test/Main.hs b/plutarch-ledger-api/test/Main.hs
index acb3777b5..608311a00 100644
--- a/plutarch-ledger-api/test/Main.hs
+++ b/plutarch-ledger-api/test/Main.hs
@@ -10,15 +10,20 @@ import Plutarch.LedgerApi qualified as PlutarchLA
 import Plutarch.Lift (PUnsafeLiftDecl (PLifted))
 import Plutarch.Prelude (
   PAsData,
+  PData,
   PIsData,
+  PTryFrom,
   S,
   pconstant,
   pdata,
   pfromData,
   plift,
+  ptryFrom,
  )
 import PlutusLedgerApi.V3 qualified as PlutusLA
 import PlutusLedgerApi.V3.Orphans ()
+import Prettyprinter (Pretty (pretty), layoutCompact)
+import Prettyprinter.Render.String (renderString)
 import Test.QuickCheck (
   Arbitrary (arbitrary, shrink),
   forAllShrinkShow,
@@ -86,6 +91,29 @@ main = do
             , pIsDataLaws @PlutarchLA.PLovelace
             , pIsDataLaws @(PlutarchLA.PValue PlutarchLA.Unsorted PlutarchLA.NonZero)
             ]
+        , adjustOption slightlyFewerTests $
+            testGroup
+              "PTryFrom"
+              [ ptryFromLaws @PlutarchLA.PAddress
+              , ptryFromLaws @PlutarchLA.PCredential
+              , ptryFromLaws @PlutarchLA.PStakingCredential
+              , ptryFromLaws @PlutarchLA.PPubKeyHash
+              , ptryFromLaws @PlutarchLA.PPosixTime
+              , ptryFromLaws @(PlutarchLA.PExtended PlutarchLA.PPosixTime)
+              , ptryFromLaws @(PlutarchLA.PLowerBound PlutarchLA.PPosixTime)
+              , ptryFromLaws @(PlutarchLA.PUpperBound PlutarchLA.PPosixTime)
+              , ptryFromLaws @(PlutarchLA.PInterval PlutarchLA.PPosixTime)
+              , ptryFromLaws @PlutarchLA.PScriptHash
+              , ptryFromLaws @PlutarchLA.PDatum
+              , ptryFromLaws @PlutarchLA.PRedeemer
+              , ptryFromLaws @PlutarchLA.PDatumHash
+              , ptryFromLaws @PlutarchLA.PRedeemerHash
+              , ptryFromLaws @PlutarchLA.PCurrencySymbol
+              , ptryFromLaws @PlutarchLA.PTokenName
+              , ptryFromLaws @PlutarchLA.PLovelace
+              -- , ptryFromLaws @(PlutarchLA.PValue PlutarchLA.Unsorted PlutarchLA.NonZero)
+              -- Need PAsData handler because Plutarch is special
+              ]
         ]
     , testGroup
         "V3"
@@ -143,6 +171,34 @@ main = do
             , pIsDataLaws @PlutarchLA.PTxOut
             , pIsDataLaws @PlutarchLA.POutputDatum
             ]
+        , adjustOption slightlyFewerTests $
+            testGroup
+              "PTryFrom"
+              [ ptryFromLaws @PlutarchLA.PColdCommitteeCredential
+              , ptryFromLaws @PlutarchLA.PHotCommitteeCredential
+              , ptryFromLaws @PlutarchLA.PDRepCredential
+              , ptryFromLaws @PlutarchLA.PDRep
+              , ptryFromLaws @PlutarchLA.PDelegatee
+              , ptryFromLaws @PlutarchLA.PTxCert
+              , ptryFromLaws @PlutarchLA.PVoter
+              , ptryFromLaws @PlutarchLA.PVote
+              , ptryFromLaws @PlutarchLA.PGovernanceActionId
+              , ptryFromLaws @PlutarchLA.PCommittee
+              , ptryFromLaws @PlutarchLA.PConstitution
+              , ptryFromLaws @PlutarchLA.PProtocolVersion
+              , ptryFromLaws @PlutarchLA.PChangedParameters
+              , ptryFromLaws @PlutarchLA.PGovernanceAction
+              , ptryFromLaws @PlutarchLA.PProposalProcedure
+              , ptryFromLaws @PlutarchLA.PScriptPurpose
+              , ptryFromLaws @PlutarchLA.PScriptInfo
+              , ptryFromLaws @PlutarchLA.PTxInInfo
+              , adjustOption fewerTests $ ptryFromLaws @PlutarchLA.PTxInfo
+              , adjustOption fewerTests $ ptryFromLaws @PlutarchLA.PScriptContext
+              , ptryFromLaws @PlutarchLA.PTxId
+              , ptryFromLaws @PlutarchLA.PTxOutRef
+              , ptryFromLaws @PlutarchLA.PTxOut
+              , ptryFromLaws @PlutarchLA.POutputDatum
+              ]
         ]
     ]
   where
@@ -153,6 +209,9 @@ main = do
     -- TODO: Fix those.
     fewerTests :: QuickCheckTests -> QuickCheckTests
     fewerTests = const 500
+    -- PTryFrom tests run slow too
+    slightlyFewerTests :: QuickCheckTests -> QuickCheckTests
+    slightlyFewerTests = (`quot` 2)
 
 -- Properties
 
@@ -217,3 +276,30 @@ pIsDataLaws =
           plift (pfromData . punsafeCoerce @_ @_ @(PAsData a) . pconstant . PlutusLA.toData $ x) === x
     coerceName :: String
     coerceName = "plift . pfromData . punsafeCoerce @(PAsData " <> groupName <> ") . pconstant . toData = id"
+
+ptryFromLaws ::
+  forall (a :: S -> Type).
+  ( Arbitrary (PLifted a)
+  , Show (PLifted a)
+  , PUnsafeLiftDecl a
+  , Eq (PLifted a)
+  , Typeable a
+  , PTryFrom PData a
+  , PlutusLA.ToData (PLifted a)
+  , Pretty (PLifted a)
+  ) =>
+  TestTree
+ptryFromLaws = testGroup groupName [pDataAgreementProp]
+  where
+    groupName :: String
+    groupName = tyConName . typeRepTyCon $ typeRep @a
+    pDataAgreementProp :: TestTree
+    pDataAgreementProp = testProperty "can parse toData of original"
+      . forAllShrinkShow arbitrary shrink prettyShow
+      $ \(x :: PLifted a) ->
+        plift (ptryFrom @a (pconstant . PlutusLA.toData $ x) fst) === x
+
+-- Helpers
+
+prettyShow :: forall (a :: Type). Pretty a => a -> String
+prettyShow = renderString . layoutCompact . pretty
diff --git a/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs b/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
index 688f4839c..ed46c38f1 100644
--- a/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
+++ b/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
@@ -11,6 +11,7 @@ import Control.Monad (guard)
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.Coerce (coerce)
+import Data.List (sortOn)
 import Data.Set qualified as Set
 import PlutusLedgerApi.Orphans.Common (getBlake2b244Hash)
 import PlutusLedgerApi.V1 qualified as PLA
@@ -75,7 +76,7 @@ instance Function PLA.CurrencySymbol where
   {-# INLINEABLE function #-}
   function = functionMap coerce PLA.CurrencySymbol
 
-{- | A Value with positive Ada, suitable for 'PLA.TxOut'.
+{- | A sorted Value with positive Ada, suitable for 'PLA.TxOut'.
 
 = Note
 
@@ -85,7 +86,7 @@ be /very/ certain that the Value being wrapped satisfies the invariants
 described above: failing to do so means all guarantees of this type are off
 the table.
 
-@since 1.0.0
+@since 1.0.1
 -}
 newtype UTxOValue = UTxOValue PLA.Value
   deriving
@@ -101,15 +102,21 @@ newtype UTxOValue = UTxOValue PLA.Value
 -- | @since 1.0.0
 instance Arbitrary UTxOValue where
   {-# INLINEABLE arbitrary #-}
-  -- Generate a NonAdaValue, then force a positive Ada value into it.
   arbitrary =
     UTxOValue <$> do
       NonAdaValue v <- arbitrary
       Positive adaQuantity <- arbitrary
-      pure $ v <> Value.singleton "" "" adaQuantity
+      -- Ensure everything is sorted by keys
+      let adaValue = Value.singleton "" "" adaQuantity
+      let vAsAssocs = Value.getValue v
+      let adaValueAsAssocs = Value.getValue adaValue
+      let combined = AssocMap.toList vAsAssocs <> AssocMap.toList adaValueAsAssocs
+      let sorted = sortOn fst . fmap (fmap (AssocMap.unsafeFromList . sortOn fst . AssocMap.toList)) $ combined
+      pure . Value.Value . AssocMap.unsafeFromList $ sorted
   {-# INLINEABLE shrink #-}
   shrink (UTxOValue v) =
     UTxOValue <$> do
+      -- We preserve ordering, as we don't shrink keys, only drop them
       v' <- shrink v
       guard (Value.valueOf v' "" "" > 0)
       pure v'

From e834ccf00dc63bf54b90185d1fd4165d1d9e1855 Mon Sep 17 00:00:00 2001
From: Koz Ross <koz.ross@retro-freedom.nz>
Date: Wed, 3 Jul 2024 09:37:21 +1200
Subject: [PATCH 2/4] Restore and document invariants for TxOut's Value

---
 .../src/Plutarch/LedgerApi/Tx.hs              |  2 +-
 .../src/PlutusLedgerApi/V1/Orphans/Value.hs   | 59 ++++++++++++++-----
 2 files changed, 44 insertions(+), 17 deletions(-)

diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/Tx.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/Tx.hs
index 11d9d4272..80af24f6a 100644
--- a/plutarch-ledger-api/src/Plutarch/LedgerApi/Tx.hs
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/Tx.hs
@@ -152,7 +152,7 @@ newtype PTxOut (s :: S)
           s
           ( PDataRecord
               '[ "address" ':= PAddress
-               , "value" ':= Value.PValue 'AssocMap.Sorted 'Value.NoGuarantees
+               , "value" ':= Value.PValue 'AssocMap.Sorted 'Value.Positive
                , "datum" ':= POutputDatum
                , "referenceScript" ':= PMaybeData PScriptHash
                ]
diff --git a/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs b/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
index ed46c38f1..fa2ebb066 100644
--- a/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
+++ b/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
@@ -11,7 +11,6 @@ import Control.Monad (guard)
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
 import Data.Coerce (coerce)
-import Data.List (sortOn)
 import Data.Set qualified as Set
 import PlutusLedgerApi.Orphans.Common (getBlake2b244Hash)
 import PlutusLedgerApi.V1 qualified as PLA
@@ -31,6 +30,7 @@ import Test.QuickCheck (
   frequency,
   functionMap,
   getNonEmpty,
+  getPositive,
   resize,
   scale,
   sized,
@@ -76,7 +76,12 @@ instance Function PLA.CurrencySymbol where
   {-# INLINEABLE function #-}
   function = functionMap coerce PLA.CurrencySymbol
 
-{- | A sorted Value with positive Ada, suitable for 'PLA.TxOut'.
+{- | A 'PLA.Value' suitable for 'PLA.TxOut'. Specifically:
+
+* The `PLA.Value` is sorted by both keys (meaning 'PLA.CurrencySymbol' and
+  'PLA.TokenName');
+* There exists an Ada amount; and
+* All amounts are positive.
 
 = Note
 
@@ -104,22 +109,44 @@ instance Arbitrary UTxOValue where
   {-# INLINEABLE arbitrary #-}
   arbitrary =
     UTxOValue <$> do
-      NonAdaValue v <- arbitrary
       Positive adaQuantity <- arbitrary
-      -- Ensure everything is sorted by keys
-      let adaValue = Value.singleton "" "" adaQuantity
-      let vAsAssocs = Value.getValue v
-      let adaValueAsAssocs = Value.getValue adaValue
-      let combined = AssocMap.toList vAsAssocs <> AssocMap.toList adaValueAsAssocs
-      let sorted = sortOn fst . fmap (fmap (AssocMap.unsafeFromList . sortOn fst . AssocMap.toList)) $ combined
-      pure . Value.Value . AssocMap.unsafeFromList $ sorted
+      -- Set of non-Ada currency symbols
+      csSet <- Set.fromList <$> liftArbitrary (PLA.CurrencySymbol . getBlake2b244Hash <$> arbitrary)
+      let cses = Set.toList csSet
+      -- For each key, generate a set of token names that aren't Ada, and a
+      -- positive value
+      table <- traverse (scale (`quot` 8) . mkInner) cses
+      -- Jam the Ada value in there
+      let table' = (Value.adaSymbol, [(Value.adaToken, adaQuantity)]) : table
+      pure . Value.Value . AssocMap.unsafeFromList . fmap (fmap AssocMap.unsafeFromList) $ table'
+    where
+      mkInner :: PLA.CurrencySymbol -> Gen (PLA.CurrencySymbol, [(PLA.TokenName, Integer)])
+      mkInner cs =
+        (cs,) <$> do
+          -- Set of non-Ada token names
+          tnSet <- Set.fromList <$> liftArbitrary genNonAdaTokenName
+          let asList = Set.toList tnSet
+          traverse (\tn -> (tn,) . getPositive <$> arbitrary) asList
+      genNonAdaTokenName :: Gen PLA.TokenName
+      genNonAdaTokenName =
+        PLA.TokenName . PlutusTx.toBuiltin @ByteString . BS.pack <$> do
+          len <- chooseInt (1, 32)
+          -- ASCII printable range
+          vectorOf len . chooseBoundedIntegral $ (33, 126)
   {-# INLINEABLE shrink #-}
-  shrink (UTxOValue v) =
-    UTxOValue <$> do
-      -- We preserve ordering, as we don't shrink keys, only drop them
-      v' <- shrink v
-      guard (Value.valueOf v' "" "" > 0)
-      pure v'
+  shrink (UTxOValue (Value.Value v)) =
+    UTxOValue . Value.Value <$> do
+      -- To ensure we don't break anything, we shrink in only two ways:
+      --
+      -- 1. Dropping keys (outer or inner)
+      -- 2. Shrinking amounts
+      --
+      -- To make this a bit easier on ourselves, we first 'unpack' the Value
+      -- completely, shrink the resulting (nested) list, then 'repack'. As neither
+      -- of these changes affect order or uniqueness, we're safe.
+      let asList = fmap AssocMap.toList <$> AssocMap.toList v
+      shrunk <- liftShrink (\(cs, inner) -> (cs,) <$> liftShrink (\(tn, amount) -> (tn,) . getPositive <$> shrink (Positive amount)) inner) asList
+      pure . AssocMap.unsafeFromList . fmap (fmap AssocMap.unsafeFromList) $ shrunk
 
 -- | @since 1.0.0
 deriving via PLA.Value instance CoArbitrary UTxOValue

From ac66b6c1e63f0ab00d2b615322ed04e35d5a40a7 Mon Sep 17 00:00:00 2001
From: Koz Ross <koz.ross@retro-freedom.nz>
Date: Wed, 3 Jul 2024 10:50:41 +1200
Subject: [PATCH 3/4] Tests pass

---
 .../src/Plutarch/LedgerApi/Contexts.hs        |  2 +-
 .../src/PlutusLedgerApi/V1/Orphans/Value.hs   | 52 ++++++++++++++++
 .../src/PlutusLedgerApi/V2/Orphans.hs         | 61 ++-----------------
 .../src/PlutusLedgerApi/V3/Orphans.hs         | 18 +++---
 4 files changed, 69 insertions(+), 64 deletions(-)

diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/Contexts.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/Contexts.hs
index 6e5bbb004..ebc126dc5 100644
--- a/plutarch-ledger-api/src/Plutarch/LedgerApi/Contexts.hs
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/Contexts.hs
@@ -827,7 +827,7 @@ newtype PTxInfo (s :: S)
                , "referenceInputs" ':= PBuiltinList (PAsData PTxInInfo)
                , "outputs" ':= PBuiltinList (PAsData PTxOut)
                , "fee" ':= Value.PLovelace
-               , "mint" ':= Value.PValue 'AssocMap.Sorted 'Value.NonZero -- value minted by transaction
+               , "mint" ':= Value.PValue 'AssocMap.Sorted 'Value.NoGuarantees -- value minted by transaction
                , "txCerts" ':= PBuiltinList (PAsData PTxCert)
                , "wdrl" ':= AssocMap.PMap 'AssocMap.Unsorted PCredential Value.PLovelace -- Staking withdrawals
                , "validRange" ':= Interval.PInterval PPosixTime
diff --git a/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs b/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
index fa2ebb066..908147c9d 100644
--- a/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
+++ b/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
@@ -1,6 +1,9 @@
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module PlutusLedgerApi.V1.Orphans.Value (
+  -- * Specialized Value wrappers
+  FeeValue (..),
+  getFeeValue,
   UTxOValue (..),
   getUtxoValue,
   NonAdaValue (..),
@@ -24,12 +27,14 @@ import Test.QuickCheck (
   Function (function),
   Gen,
   NonEmptyList (NonEmpty),
+  NonNegative (NonNegative),
   Positive (Positive),
   chooseBoundedIntegral,
   chooseInt,
   frequency,
   functionMap,
   getNonEmpty,
+  getNonNegative,
   getPositive,
   resize,
   scale,
@@ -292,3 +297,50 @@ instance Arbitrary1 NonEmptyList where
     NonEmpty <$> case ell of
       [] -> []
       (x : xs) -> (:) <$> shrinkInner x <*> liftShrink shrinkInner xs
+
+{- | A 'PLA.Value' containing only Ada, suitable for fees. Furthermore, the
+Ada quantity is non-negative.
+
+= Note
+
+This is designed to act as a modifier, and thus, we expose the constructor
+even though it preserves invariants. If you use the constructor directly,
+be /very/ certain that the Value being wrapped satisfies the invariants
+described above: failing to do so means all guarantees of this type are off
+the table.
+
+@since 1.0.0
+-}
+newtype FeeValue = FeeValue PLA.Value
+  deriving
+    ( -- | @since 1.0.0
+      Eq
+    )
+    via PLA.Value
+  deriving stock
+    ( -- | @since 1.0.0
+      Show
+    )
+
+-- | @since 1.0.0
+instance Arbitrary FeeValue where
+  {-# INLINEABLE arbitrary #-}
+  arbitrary = FeeValue . PLA.singleton PLA.adaSymbol PLA.adaToken . getNonNegative <$> arbitrary
+  {-# INLINEABLE shrink #-}
+  shrink (FeeValue v) =
+    FeeValue . PLA.singleton PLA.adaSymbol PLA.adaToken <$> do
+      let adaAmount = Value.valueOf v PLA.adaSymbol PLA.adaToken
+      NonNegative adaAmount' <- shrink (NonNegative adaAmount)
+      pure adaAmount'
+
+-- | @since 1.0.0
+deriving via PLA.Value instance CoArbitrary FeeValue
+
+-- | @since 1.0.0
+instance Function FeeValue where
+  {-# INLINEABLE function #-}
+  function = functionMap coerce FeeValue
+
+-- | @since 1.0.0
+getFeeValue :: FeeValue -> PLA.Value
+getFeeValue = coerce
diff --git a/plutarch-orphanage/src/PlutusLedgerApi/V2/Orphans.hs b/plutarch-orphanage/src/PlutusLedgerApi/V2/Orphans.hs
index ec5fb0357..07964b540 100644
--- a/plutarch-orphanage/src/PlutusLedgerApi/V2/Orphans.hs
+++ b/plutarch-orphanage/src/PlutusLedgerApi/V2/Orphans.hs
@@ -9,13 +9,12 @@
 
 -- | QuickCheck orphans (plus a few helpers) for V2 Plutus ledger API types.
 module PlutusLedgerApi.V2.Orphans (
-  -- * Specialized Value wrappers
-  FeeValue (..),
-  getFeeValue,
   Value.NonAdaValue (..),
   Value.getNonAdaValue,
   Value.UTxOValue (..),
   Value.getUtxoValue,
+  Value.FeeValue (..),
+  Value.getFeeValue,
 ) where
 
 import Data.ByteString (ByteString)
@@ -34,7 +33,6 @@ import PlutusLedgerApi.V1.Orphans.Interval ()
 import PlutusLedgerApi.V1.Orphans.Scripts ()
 import PlutusLedgerApi.V1.Orphans.Time ()
 import PlutusLedgerApi.V1.Orphans.Value qualified as Value
-import PlutusLedgerApi.V1.Value qualified as Value
 import PlutusLedgerApi.V2 qualified as PLA
 import PlutusLedgerApi.V2.Orphans.Tx ()
 import PlutusTx.AssocMap qualified as AssocMap
@@ -163,53 +161,6 @@ instance Function PLA.DCert where
         Just (Just (Right (Right (Right (Left (pkh, pkh')))))) -> PLA.DCertPoolRegister pkh pkh'
         Just (Just (Right (Right (Right (Right (pkh, e)))))) -> PLA.DCertPoolRetire pkh e
 
-{- | A 'PLA.Value' containing only Ada, suitable for fees. Furthermore, the
-Ada quantity is non-negative.
-
-= Note
-
-This is designed to act as a modifier, and thus, we expose the constructor
-even though it preserves invariants. If you use the constructor directly,
-be /very/ certain that the Value being wrapped satisfies the invariants
-described above: failing to do so means all guarantees of this type are off
-the table.
-
-@since 1.0.0
--}
-newtype FeeValue = FeeValue PLA.Value
-  deriving
-    ( -- | @since 1.0.0
-      Eq
-    )
-    via PLA.Value
-  deriving stock
-    ( -- | @since 1.0.0
-      Show
-    )
-
--- | @since 1.0.0
-instance Arbitrary FeeValue where
-  {-# INLINEABLE arbitrary #-}
-  arbitrary = FeeValue . PLA.singleton PLA.adaSymbol PLA.adaToken . getNonNegative <$> arbitrary
-  {-# INLINEABLE shrink #-}
-  shrink (FeeValue v) =
-    FeeValue . PLA.singleton PLA.adaSymbol PLA.adaToken <$> do
-      let adaAmount = Value.valueOf v PLA.adaSymbol PLA.adaToken
-      NonNegative adaAmount' <- shrink (NonNegative adaAmount)
-      pure adaAmount'
-
--- | @since 1.0.0
-deriving via PLA.Value instance CoArbitrary FeeValue
-
--- | @since 1.0.0
-instance Function FeeValue where
-  {-# INLINEABLE function #-}
-  function = functionMap coerce FeeValue
-
--- | @since 1.0.0
-getFeeValue :: FeeValue -> PLA.Value
-getFeeValue = coerce
-
 {- | BLAKE2b-256 hash (32 bytes) of a transaction ID.
 
 @since 1.0.0
@@ -322,7 +273,7 @@ instance Arbitrary PLA.TxInfo where
       <$> arbitrary
       <*> (getNonEmpty <$> arbitrary)
       <*> arbitrary
-      <*> (getFeeValue <$> arbitrary)
+      <*> (Value.getFeeValue <$> arbitrary)
       <*> (Value.getNonAdaValue <$> arbitrary)
       <*> arbitrary
       <*> arbitrary
@@ -335,9 +286,9 @@ instance Arbitrary PLA.TxInfo where
   shrink (PLA.TxInfo ins routs outs fee mint dcert wdrl validRange sigs reds dats tid) =
     PLA.TxInfo . getNonEmpty
       <$> shrink (NonEmpty ins)
-      <*> (getNonEmpty <$> shrink (NonEmpty routs))
-      <*> shrink outs
-      <*> (getFeeValue <$> shrink (FeeValue fee))
+      <*> shrink routs
+      <*> (getNonEmpty <$> shrink (NonEmpty outs))
+      <*> (Value.getFeeValue <$> shrink (Value.FeeValue fee))
       <*> (Value.getNonAdaValue <$> shrink (Value.NonAdaValue mint))
       <*> shrink dcert
       <*> shrink wdrl
diff --git a/plutarch-orphanage/src/PlutusLedgerApi/V3/Orphans.hs b/plutarch-orphanage/src/PlutusLedgerApi/V3/Orphans.hs
index 3f68a3049..554088441 100644
--- a/plutarch-orphanage/src/PlutusLedgerApi/V3/Orphans.hs
+++ b/plutarch-orphanage/src/PlutusLedgerApi/V3/Orphans.hs
@@ -12,6 +12,7 @@ import PlutusLedgerApi.V1.Orphans.Credential ()
 import PlutusLedgerApi.V1.Orphans.Interval ()
 import PlutusLedgerApi.V1.Orphans.Time ()
 import PlutusLedgerApi.V1.Orphans.Value ()
+import PlutusLedgerApi.V1.Orphans.Value qualified as Value
 import PlutusLedgerApi.V2.Orphans.Tx ()
 import PlutusLedgerApi.V3 qualified as PLA
 import PlutusTx.AssocMap qualified as AssocMap
@@ -23,11 +24,13 @@ import Test.QuickCheck (
   Arbitrary1 (liftArbitrary, liftShrink),
   CoArbitrary (coarbitrary),
   Function (function),
+  NonEmptyList (NonEmpty),
   NonNegative (NonNegative),
   Positive (Positive),
   chooseInt,
   elements,
   functionMap,
+  getNonEmpty,
   getNonNegative,
   getPositive,
   oneof,
@@ -856,15 +859,15 @@ instance Arbitrary PLA.TxInInfo where
 instance Arbitrary PLA.TxInfo where
   {-# INLINEABLE arbitrary #-}
   arbitrary = do
-    ins <- arbitrary
+    ins <- getNonEmpty <$> arbitrary
     routs <- arbitrary
-    outs <- arbitrary
+    outs <- getNonEmpty <$> arbitrary
     fee <- arbitrary
-    mint <- arbitrary
+    mint <- Value.getNonAdaValue <$> arbitrary
     cert <- arbitrary
     wdrl <- arbitrary
     valid <- arbitrary
-    sigs <- arbitrary
+    sigs <- Set.toList <$> arbitrary
     reds <- arbitrary
     dats <- arbitrary
     tid <- arbitrary
@@ -875,11 +878,11 @@ instance Arbitrary PLA.TxInfo where
     pure . PLA.TxInfo ins routs outs fee mint cert wdrl valid sigs reds dats tid votes pps currT $ tDonation
   {-# INLINEABLE shrink #-}
   shrink (PLA.TxInfo ins routs outs fee mint cert wdrl valid sigs reds dats tid votes pps currT tDonation) = do
-    ins' <- shrink ins
+    NonEmpty ins' <- shrink (NonEmpty ins)
     routs' <- shrink routs
-    outs' <- shrink outs
+    NonEmpty outs' <- shrink (NonEmpty outs)
     fee' <- shrink fee
-    mint' <- shrink mint
+    (Value.NonAdaValue mint') <- shrink (Value.NonAdaValue mint)
     cert' <- shrink cert
     wdrl' <- shrink wdrl
     valid' <- shrink valid
@@ -894,7 +897,6 @@ instance Arbitrary PLA.TxInfo where
     pure . PLA.TxInfo ins' routs' outs' fee' mint' cert' wdrl' valid' sigs' reds' dats' tid' votes' pps' currT' $ tDonation'
 
 -- TODO: CoArbitrary, Function
--- TODO: Invariants?
 
 -- | @since 1.0.1
 instance Arbitrary PLA.ScriptContext where

From 3fe24979a858c2ac504dd85c48f808036d4c9760 Mon Sep 17 00:00:00 2001
From: Koz Ross <koz.ross@retro-freedom.nz>
Date: Thu, 4 Jul 2024 10:19:40 +1200
Subject: [PATCH 4/4] All tests pass

---
 plutarch-ledger-api/plutarch-ledger-api.cabal |   2 +
 .../src/Plutarch/LedgerApi/V1.hs              |  47 +-----
 .../src/Plutarch/LedgerApi/V1/Contexts.hs     |  59 ++++++++
 .../src/Plutarch/LedgerApi/V1/Tx.hs           |   9 +-
 .../src/Plutarch/LedgerApi/V2.hs              |  19 ++-
 .../src/Plutarch/LedgerApi/V3.hs              |  12 +-
 .../src/Plutarch/LedgerApi/V3/Contexts.hs     |   2 +-
 .../src/Plutarch/LedgerApi/V3/Tx.hs           | 134 ++++++++++++++++++
 plutarch-orphanage/CHANGELOG.md               |   6 +-
 .../src/PlutusLedgerApi/V1/Orphans/Value.hs   |   4 +-
 10 files changed, 225 insertions(+), 69 deletions(-)
 create mode 100644 plutarch-ledger-api/src/Plutarch/LedgerApi/V1/Contexts.hs
 create mode 100644 plutarch-ledger-api/src/Plutarch/LedgerApi/V3/Tx.hs

diff --git a/plutarch-ledger-api/plutarch-ledger-api.cabal b/plutarch-ledger-api/plutarch-ledger-api.cabal
index 3521405f5..2d0f13190 100644
--- a/plutarch-ledger-api/plutarch-ledger-api.cabal
+++ b/plutarch-ledger-api/plutarch-ledger-api.cabal
@@ -66,6 +66,7 @@ library
 
   other-modules:
     Plutarch.LedgerApi.V1.Address
+    Plutarch.LedgerApi.V1.Contexts
     Plutarch.LedgerApi.V1.Credential
     Plutarch.LedgerApi.V1.Crypto
     Plutarch.LedgerApi.V1.DCert
@@ -74,6 +75,7 @@ library
     Plutarch.LedgerApi.V1.Tx
     Plutarch.LedgerApi.V2.Tx
     Plutarch.LedgerApi.V3.Contexts
+    Plutarch.LedgerApi.V3.Tx
 
   build-depends:
     , bytestring
diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/V1.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/V1.hs
index 1b1250b5e..88d8a09e8 100644
--- a/plutarch-ledger-api/src/Plutarch/LedgerApi/V1.hs
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/V1.hs
@@ -2,7 +2,7 @@
 
 module Plutarch.LedgerApi.V1 (
   -- * Contexts
-  PScriptPurpose (..),
+  Contexts.PScriptPurpose (..),
   PScriptContext (..),
 
   -- * Certificates
@@ -57,6 +57,7 @@ import Plutarch.DataRepr (
 import Plutarch.LedgerApi.AssocMap qualified as AssocMap
 import Plutarch.LedgerApi.Interval qualified as Interval
 import Plutarch.LedgerApi.V1.Address qualified as Address
+import Plutarch.LedgerApi.V1.Contexts qualified as Contexts
 import Plutarch.LedgerApi.V1.Credential qualified as Credential
 import Plutarch.LedgerApi.V1.Crypto qualified as Crypto
 import Plutarch.LedgerApi.V1.DCert qualified as DCert
@@ -162,46 +163,6 @@ deriving via
 -- | @since 3.1.1
 instance PTryFrom PData (PAsData PTxInInfo)
 
--- | @since 3.1.1
-data PScriptPurpose (s :: S)
-  = PMinting (Term s (PDataRecord '["_0" ':= Value.PCurrencySymbol]))
-  | PSpending (Term s (PDataRecord '["_0" ':= Tx.PTxOutRef]))
-  | PRewarding (Term s (PDataRecord '["_0" ':= Credential.PStakingCredential]))
-  | PCertifying (Term s (PDataRecord '["_0" ':= DCert.PDCert]))
-  deriving stock
-    ( -- | @since 3.1.1
-      Generic
-    )
-  deriving anyclass
-    ( -- | @since 3.1.1
-      PlutusType
-    , -- | @since 3.1.1
-      PIsData
-    , -- | @since 3.1.1
-      PEq
-    , -- | @since 3.1.1
-      PShow
-    , -- | @since 3.1.1
-      PTryFrom PData
-    )
-
--- | @since 3.1.1
-instance DerivePlutusType PScriptPurpose where
-  type DPTStrat _ = PlutusTypeData
-
--- | @since 3.1.1
-instance PUnsafeLiftDecl PScriptPurpose where
-  type PLifted PScriptPurpose = Plutus.ScriptPurpose
-
--- | @since 3.1.1
-deriving via
-  (DerivePConstantViaData Plutus.ScriptPurpose PScriptPurpose)
-  instance
-    PConstantDecl Plutus.ScriptPurpose
-
--- | @since 3.1.1
-instance PTryFrom PData (PAsData PScriptPurpose)
-
 -- | @since 3.1.1
 newtype PTxInfo (s :: S)
   = PTxInfo
@@ -216,7 +177,7 @@ newtype PTxInfo (s :: S)
                , "wdrl" ':= AssocMap.PMap 'AssocMap.Unsorted Credential.PStakingCredential PInteger -- Staking withdrawals
                , "validRange" ':= Interval.PInterval Time.PPosixTime
                , "signatories" ':= PBuiltinList (PAsData Crypto.PPubKeyHash)
-               , "redeemers" ':= AssocMap.PMap 'AssocMap.Unsorted PScriptPurpose Scripts.PRedeemer
+               , "redeemers" ':= AssocMap.PMap 'AssocMap.Unsorted Contexts.PScriptPurpose Scripts.PRedeemer
                , "data" ':= AssocMap.PMap 'AssocMap.Unsorted Scripts.PDatumHash Scripts.PDatum
                , "id" ':= Tx.PTxId -- hash of the pending transaction
                ]
@@ -260,7 +221,7 @@ instance PTryFrom PData (PAsData PTxInfo)
 
 -- | @since 3.1.1
 newtype PScriptContext (s :: S)
-  = PScriptContext (Term s (PDataRecord '["txInfo" ':= PTxInfo, "purpose" ':= PScriptPurpose]))
+  = PScriptContext (Term s (PDataRecord '["txInfo" ':= PTxInfo, "purpose" ':= Contexts.PScriptPurpose]))
   deriving stock
     ( -- | @since 3.1.1
       Generic
diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/V1/Contexts.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/V1/Contexts.hs
new file mode 100644
index 000000000..250facf0a
--- /dev/null
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/V1/Contexts.hs
@@ -0,0 +1,59 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Plutarch.LedgerApi.V1.Contexts (
+  PScriptPurpose (..),
+) where
+
+import Plutarch.DataRepr (
+  DerivePConstantViaData (DerivePConstantViaData),
+ )
+import Plutarch.LedgerApi.V1.Credential qualified as Credential
+import Plutarch.LedgerApi.V1.DCert qualified as DCert
+import Plutarch.LedgerApi.V1.Tx qualified as Tx
+import Plutarch.LedgerApi.Value qualified as Value
+import Plutarch.Lift (
+  PConstantDecl,
+  PUnsafeLiftDecl (PLifted),
+ )
+import Plutarch.Prelude
+import PlutusLedgerApi.V1 qualified as Plutus
+
+-- | @since 3.1.1
+data PScriptPurpose (s :: S)
+  = PMinting (Term s (PDataRecord '["_0" ':= Value.PCurrencySymbol]))
+  | PSpending (Term s (PDataRecord '["_0" ':= Tx.PTxOutRef]))
+  | PRewarding (Term s (PDataRecord '["_0" ':= Credential.PStakingCredential]))
+  | PCertifying (Term s (PDataRecord '["_0" ':= DCert.PDCert]))
+  deriving stock
+    ( -- | @since 3.1.1
+      Generic
+    )
+  deriving anyclass
+    ( -- | @since 3.1.1
+      PlutusType
+    , -- | @since 3.1.1
+      PIsData
+    , -- | @since 3.1.1
+      PEq
+    , -- | @since 3.1.1
+      PShow
+    , -- | @since 3.1.1
+      PTryFrom PData
+    )
+
+-- | @since 3.1.1
+instance DerivePlutusType PScriptPurpose where
+  type DPTStrat _ = PlutusTypeData
+
+-- | @since 3.1.1
+instance PUnsafeLiftDecl PScriptPurpose where
+  type PLifted PScriptPurpose = Plutus.ScriptPurpose
+
+-- | @since 3.1.1
+deriving via
+  (DerivePConstantViaData Plutus.ScriptPurpose PScriptPurpose)
+  instance
+    PConstantDecl Plutus.ScriptPurpose
+
+-- | @since 3.1.1
+instance PTryFrom PData (PAsData PScriptPurpose)
diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/V1/Tx.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/V1/Tx.hs
index 1a464f8ab..31f361664 100644
--- a/plutarch-ledger-api/src/Plutarch/LedgerApi/V1/Tx.hs
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/V1/Tx.hs
@@ -6,7 +6,6 @@ module Plutarch.LedgerApi.V1.Tx (
   PTxOutRef (..),
 ) where
 
-import Plutarch.Builtin (PDataNewtype (PDataNewtype))
 import Plutarch.DataRepr (
   DerivePConstantViaData (DerivePConstantViaData),
   PDataFields,
@@ -25,7 +24,7 @@ import PlutusLedgerApi.V1 qualified as Plutus
 
 @since 3.1.0
 -}
-newtype PTxId (s :: S) = PTxId (Term s (PDataNewtype PByteString))
+newtype PTxId (s :: S) = PTxId (Term s (PDataRecord '["_0" ':= PByteString]))
   deriving stock
     ( -- | @since 2.0.0
       Generic
@@ -47,7 +46,7 @@ newtype PTxId (s :: S) = PTxId (Term s (PDataNewtype PByteString))
 
 -- | @since 3.1.0
 instance DerivePlutusType PTxId where
-  type DPTStrat _ = PlutusTypeNewtype
+  type DPTStrat _ = PlutusTypeData
 
 -- | @since 2.0.0
 instance PUnsafeLiftDecl PTxId where
@@ -69,7 +68,7 @@ instance PTryFrom PData PTxId where
         (plengthBS # unwrapped #== 32)
         (f ())
         (ptraceInfoError "ptryFrom(PTxId): must be 32 bytes long")
-    pure (punsafeCoerce opq, pcon . PTxId . pcon . PDataNewtype . pdata $ unwrapped)
+    pure (punsafeCoerce opq, pcon . PTxId $ pdcons # pdata unwrapped # pdnil)
 
 -- | @since 3.1.0
 instance PTryFrom PData (PAsData PTxId) where
@@ -81,7 +80,7 @@ instance PTryFrom PData (PAsData PTxId) where
         (plengthBS # unwrapped #== 32)
         (f ())
         (ptraceInfoError "ptryFrom(PTxId): must be 32 bytes long")
-    pure (punsafeCoerce opq, pcon . PTxId . pcon . PDataNewtype . pdata $ unwrapped)
+    pure (punsafeCoerce opq, pcon . PTxId $ pdcons # pdata unwrapped # pdnil)
 
 {- | Reference to a transaction output, with an index referencing which exact
 output we mean.
diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/V2.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/V2.hs
index 90d376596..bc285301b 100644
--- a/plutarch-ledger-api/src/Plutarch/LedgerApi/V2.hs
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/V2.hs
@@ -2,7 +2,7 @@
 
 module Plutarch.LedgerApi.V2 (
   -- * Contexts
-  V1.PScriptPurpose (..),
+  Contexts.PScriptPurpose (..),
   PScriptContext (..),
 
   -- * Certificates
@@ -51,9 +51,14 @@ module Plutarch.LedgerApi.V2 (
   AssocMap.Commutativity (..),
 ) where
 
+import Plutarch.DataRepr (
+  DerivePConstantViaData (DerivePConstantViaData),
+  PDataFields,
+ )
 import Plutarch.LedgerApi.AssocMap qualified as AssocMap
 import Plutarch.LedgerApi.Interval qualified as Interval
 import Plutarch.LedgerApi.V1.Address qualified as Address
+import Plutarch.LedgerApi.V1.Contexts qualified as Contexts
 import Plutarch.LedgerApi.V1.Credential qualified as Credential
 import Plutarch.LedgerApi.V1.Crypto qualified as Crypto
 import Plutarch.LedgerApi.V1.DCert qualified as DCert
@@ -62,14 +67,6 @@ import Plutarch.LedgerApi.V1.Time qualified as Time
 import Plutarch.LedgerApi.V1.Tx qualified as V1Tx
 import Plutarch.LedgerApi.V2.Tx qualified as V2Tx
 import Plutarch.LedgerApi.Value qualified as Value
-
--- TODO: Cleaner factoring
-
-import Plutarch.DataRepr (
-  DerivePConstantViaData (DerivePConstantViaData),
-  PDataFields,
- )
-import Plutarch.LedgerApi.V1 qualified as V1
 import Plutarch.Lift (
   PConstantDecl,
   PUnsafeLiftDecl (PLifted),
@@ -139,7 +136,7 @@ newtype PTxInfo (s :: S)
                , "wdrl" ':= AssocMap.PMap 'AssocMap.Unsorted Credential.PStakingCredential PInteger -- Staking withdrawals
                , "validRange" ':= Interval.PInterval Time.PPosixTime
                , "signatories" ':= PBuiltinList (PAsData Crypto.PPubKeyHash)
-               , "redeemers" ':= AssocMap.PMap 'AssocMap.Unsorted V1.PScriptPurpose Scripts.PRedeemer
+               , "redeemers" ':= AssocMap.PMap 'AssocMap.Unsorted Contexts.PScriptPurpose Scripts.PRedeemer
                , "data" ':= AssocMap.PMap 'AssocMap.Unsorted Scripts.PDatumHash Scripts.PDatum
                , "id" ':= V1Tx.PTxId -- hash of the pending transaction
                ]
@@ -183,7 +180,7 @@ instance PTryFrom PData (PAsData PTxInfo)
 
 -- | @since 3.1.1
 newtype PScriptContext (s :: S)
-  = PScriptContext (Term s (PDataRecord '["txInfo" ':= PTxInfo, "purpose" ':= V1.PScriptPurpose]))
+  = PScriptContext (Term s (PDataRecord '["txInfo" ':= PTxInfo, "purpose" ':= Contexts.PScriptPurpose]))
   deriving stock
     ( -- | @since 3.1.1
       Generic
diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/V3.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/V3.hs
index a2b5f417d..282d81873 100644
--- a/plutarch-ledger-api/src/Plutarch/LedgerApi/V3.hs
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/V3.hs
@@ -20,9 +20,9 @@ module Plutarch.LedgerApi.V3 (
   -- * Tx
 
   -- ** Types
-  V1Tx.PTxOutRef (..),
+  V3Tx.PTxOutRef (..),
   V2Tx.PTxOut (..),
-  V1Tx.PTxId (..),
+  V3Tx.PTxId (..),
   Contexts.PTxInInfo (..),
   V2Tx.POutputDatum (..),
 
@@ -133,9 +133,9 @@ import Plutarch.LedgerApi.V1.Credential qualified as Credential
 import Plutarch.LedgerApi.V1.Crypto qualified as Crypto
 import Plutarch.LedgerApi.V1.Scripts qualified as Scripts
 import Plutarch.LedgerApi.V1.Time qualified as Time
-import Plutarch.LedgerApi.V1.Tx qualified as V1Tx
 import Plutarch.LedgerApi.V2.Tx qualified as V2Tx
 import Plutarch.LedgerApi.V3.Contexts qualified as Contexts
+import Plutarch.LedgerApi.V3.Tx qualified as V3Tx
 import Plutarch.LedgerApi.Value qualified as Value
 import Plutarch.Prelude
 import Plutarch.Script (Script (unScript))
@@ -213,7 +213,7 @@ pgetContinuingOutputs ::
     s
     ( PBuiltinList Contexts.PTxInInfo
         :--> PBuiltinList V2Tx.PTxOut
-        :--> V1Tx.PTxOutRef
+        :--> V3Tx.PTxOutRef
         :--> PBuiltinList V2Tx.PTxOut
     )
 pgetContinuingOutputs = phoistAcyclic $
@@ -257,7 +257,7 @@ pfindOwnInput ::
   Term
     s
     ( PBuiltinList Contexts.PTxInInfo
-        :--> V1Tx.PTxOutRef
+        :--> V3Tx.PTxOutRef
         :--> PMaybe Contexts.PTxInInfo
     )
 pfindOwnInput = phoistAcyclic $
@@ -266,7 +266,7 @@ pfindOwnInput = phoistAcyclic $
   where
     matches ::
       forall (s' :: S).
-      Term s' (V1Tx.PTxOutRef :--> Contexts.PTxInInfo :--> PBool)
+      Term s' (V3Tx.PTxOutRef :--> Contexts.PTxInInfo :--> PBool)
     matches = phoistAcyclic $
       plam $ \outref txininfo ->
         outref #== pfield @"outRef" # txininfo
diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/V3/Contexts.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/V3/Contexts.hs
index 5a15df8c3..84da50f25 100644
--- a/plutarch-ledger-api/src/Plutarch/LedgerApi/V3/Contexts.hs
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/V3/Contexts.hs
@@ -54,8 +54,8 @@ import Plutarch.LedgerApi.V1.Scripts (
   PScriptHash,
  )
 import Plutarch.LedgerApi.V1.Time (PPosixTime)
-import Plutarch.LedgerApi.V1.Tx (PTxId, PTxOutRef)
 import Plutarch.LedgerApi.V2.Tx (PTxOut)
+import Plutarch.LedgerApi.V3.Tx (PTxId, PTxOutRef)
 import Plutarch.LedgerApi.Value qualified as Value
 import Plutarch.Lift (
   DerivePConstantViaBuiltin (DerivePConstantViaBuiltin),
diff --git a/plutarch-ledger-api/src/Plutarch/LedgerApi/V3/Tx.hs b/plutarch-ledger-api/src/Plutarch/LedgerApi/V3/Tx.hs
new file mode 100644
index 000000000..8180c5490
--- /dev/null
+++ b/plutarch-ledger-api/src/Plutarch/LedgerApi/V3/Tx.hs
@@ -0,0 +1,134 @@
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Plutarch.LedgerApi.V3.Tx (
+  PTxId (..),
+  PTxOutRef (..),
+) where
+
+import Plutarch.Builtin (PDataNewtype (PDataNewtype))
+import Plutarch.DataRepr (
+  DerivePConstantViaData (DerivePConstantViaData),
+  PDataFields,
+ )
+import Plutarch.LedgerApi.Utils (Mret)
+import Plutarch.Lift (
+  PConstantDecl,
+  PUnsafeLiftDecl (PLifted),
+ )
+import Plutarch.Prelude
+import Plutarch.TryFrom (PTryFrom (PTryFromExcess, ptryFrom'))
+import Plutarch.Unsafe (punsafeCoerce)
+import PlutusLedgerApi.V3 qualified as Plutus
+
+{- | Hashed with @BLAKE2b-256@.
+
+@since 3.1.0
+-}
+newtype PTxId (s :: S) = PTxId (Term s (PDataNewtype PByteString))
+  deriving stock
+    ( -- | @since 2.0.0
+      Generic
+    )
+  deriving anyclass
+    ( -- | @since 2.0.0
+      PlutusType
+    , -- | @since 2.0.0
+      PIsData
+    , -- | @since 2.0.0
+      PEq
+    , -- | @since 2.0.0
+      PPartialOrd
+    , -- | @since 2.0.0
+      POrd
+    , -- | @since 2.0.0
+      PShow
+    )
+
+-- | @since 3.1.0
+instance DerivePlutusType PTxId where
+  type DPTStrat _ = PlutusTypeNewtype
+
+-- | @since 2.0.0
+instance PUnsafeLiftDecl PTxId where
+  type PLifted PTxId = Plutus.TxId
+
+-- | @since 3.1.0
+deriving via
+  (DerivePConstantViaData Plutus.TxId PTxId)
+  instance
+    PConstantDecl Plutus.TxId
+
+-- | @since 3.1.0
+instance PTryFrom PData PTxId where
+  type PTryFromExcess PData PTxId = Mret PTxId
+  ptryFrom' opq = runTermCont $ do
+    unwrapped <- tcont . plet $ ptryFrom @(PAsData PByteString) opq snd
+    tcont $ \f ->
+      pif
+        (plengthBS # unwrapped #== 32)
+        (f ())
+        (ptraceInfoError "ptryFrom(PTxId): must be 32 bytes long")
+    pure (punsafeCoerce opq, pcon . PTxId . pcon . PDataNewtype . pdata $ unwrapped)
+
+-- | @since 3.1.0
+instance PTryFrom PData (PAsData PTxId) where
+  type PTryFromExcess PData (PAsData PTxId) = Mret PTxId
+  ptryFrom' opq = runTermCont $ do
+    unwrapped <- tcont . plet $ ptryFrom @(PAsData PByteString) opq snd
+    tcont $ \f ->
+      pif
+        (plengthBS # unwrapped #== 32)
+        (f ())
+        (ptraceInfoError "ptryFrom(PTxId): must be 32 bytes long")
+    pure (punsafeCoerce opq, pcon . PTxId . pcon . PDataNewtype . pdata $ unwrapped)
+
+-- | @since 3.1.0
+newtype PTxOutRef (s :: S)
+  = PTxOutRef
+      ( Term
+          s
+          ( PDataRecord
+              '[ "id" ':= PTxId
+               , "idx" ':= PInteger
+               ]
+          )
+      )
+  deriving stock
+    ( -- | @since 3.1.0
+      Generic
+    )
+  deriving anyclass
+    ( -- | @since 3.1.0
+      PlutusType
+    , -- | @since 3.1.0
+      PIsData
+    , -- | @since 3.1.0
+      PDataFields
+    , -- | @since 3.1.0
+      PEq
+    , -- | @since 3.1.0
+      PPartialOrd
+    , -- | @since 3.1.0
+      POrd
+    , -- | @since 3.1.0
+      PTryFrom PData
+    , -- | @since 3.1.0
+      PShow
+    )
+
+-- | @since 3.1.0
+instance DerivePlutusType PTxOutRef where
+  type DPTStrat _ = PlutusTypeData
+
+-- | @since 3.1.0
+instance PUnsafeLiftDecl PTxOutRef where
+  type PLifted PTxOutRef = Plutus.TxOutRef
+
+-- | @since 3.1.0
+deriving via
+  (DerivePConstantViaData Plutus.TxOutRef PTxOutRef)
+  instance
+    PConstantDecl Plutus.TxOutRef
+
+-- | @since 3.1.0
+instance PTryFrom PData (PAsData PTxOutRef)
diff --git a/plutarch-orphanage/CHANGELOG.md b/plutarch-orphanage/CHANGELOG.md
index c48e3b367..1911616ee 100644
--- a/plutarch-orphanage/CHANGELOG.md
+++ b/plutarch-orphanage/CHANGELOG.md
@@ -8,7 +8,11 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.1.0/).
 
 ### Added
 
-* Orphan instances for V1 ledger types
+* Orphan instances for V1 and V2 ledger types
+
+### Changed
+
+* `UTxOValue` now ensures sortedness
 
 ## 1.0.1 -- 24-06-2024
 
diff --git a/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs b/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
index 908147c9d..0ded7ed36 100644
--- a/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
+++ b/plutarch-orphanage/src/PlutusLedgerApi/V1/Orphans/Value.hs
@@ -96,7 +96,7 @@ be /very/ certain that the Value being wrapped satisfies the invariants
 described above: failing to do so means all guarantees of this type are off
 the table.
 
-@since 1.0.1
+@since 1.0.2
 -}
 newtype UTxOValue = UTxOValue PLA.Value
   deriving
@@ -109,7 +109,7 @@ newtype UTxOValue = UTxOValue PLA.Value
       Show
     )
 
--- | @since 1.0.0
+-- | @since 1.0.2
 instance Arbitrary UTxOValue where
   {-# INLINEABLE arbitrary #-}
   arbitrary =