Improve logging for UTxOs

Plutonomicon · Sep 20, 2023 · 409d6e3 · 409d6e3
1 parent 76f9be2
commit 409d6e3
Show file tree

Hide file tree

Showing 4 changed files with 106 additions and 32 deletions.
diff --git a/src/Internal/BalanceTx/BalanceTx.purs b/src/Internal/BalanceTx/BalanceTx.purs
@@ -6,10 +6,9 @@ module Ctl.Internal.BalanceTx
 
 import Prelude
 
-import Contract.Log (logTrace')
 import Control.Monad.Error.Class (catchError, liftMaybe, throwError)
 import Control.Monad.Except.Trans (ExceptT(ExceptT), except, runExceptT)
-import Control.Monad.Logger.Class (trace) as Logger
+import Control.Monad.Logger.Class (info) as Logger
 import Control.Monad.Reader (asks)
 import Control.Parallel (parTraverse)
 import Ctl.Internal.BalanceTx.CoinSelection
@@ -107,6 +106,7 @@ import Ctl.Internal.Cardano.Types.Transaction
   , _referenceInputs
   , _withdrawals
   , _witnessSet
+  , pprintUtxoMap
   )
 import Ctl.Internal.Cardano.Types.Value
   ( AssetClass
@@ -161,7 +161,7 @@ import Data.Foldable (fold, foldMap, foldr, length, null, sum)
 import Data.Function (on)
 import Data.Lens.Getter ((^.))
 import Data.Lens.Setter ((%~), (.~), (?~))
-import Data.Log.Tag (TagSet, tag)
+import Data.Log.Tag (TagSet, tag, tagSetTag)
 import Data.Log.Tag (fromArray) as TagSet
 import Data.Map (Map)
 import Data.Map (empty, insert, lookup, toUnfoldable, union) as Map
@@ -235,9 +235,10 @@ balanceTxWithConstraints transaction extraUtxos constraintsBuilder = do
         utxos `Map.union` extraUtxos
 
     availableUtxos <- liftContract $ filterLockedUtxos allUtxos
-    logTrace' $ "balanceTxWithConstraints: all UTxOs: " <> show allUtxos
-    logTrace' $ "balanceTxWithConstraints: available UTxOs: " <> show
-      availableUtxos
+
+    Logger.info (pprintUtxoMap allUtxos) "balanceTxWithConstraints: all UTxOs"
+    Logger.info (pprintUtxoMap availableUtxos)
+      "balanceTxWithConstraints: available UTxOs"
 
     selectionStrategy <- asksConstraints Constraints._selectionStrategy
 
@@ -875,19 +876,20 @@ logTransactionWithChange message utxos mChangeOutputs tx =
 
     outputValuesTagSet :: Maybe (Array TransactionOutput) -> Array TagSet
     outputValuesTagSet Nothing =
-      [ "Output Value" `tag` pprintValue (outputValue txBody) ]
+      [ "Output Value" `tagSetTag` pprintValue (outputValue txBody) ]
     outputValuesTagSet (Just changeOutputs) =
-      [ "Output Value without change" `tag` pprintValue (outputValue txBody)
-      , "Change Value" `tag` pprintValue (foldMap getAmount changeOutputs)
+      [ "Output Value without change" `tagSetTag` pprintValue
+          (outputValue txBody)
+      , "Change Value" `tagSetTag` pprintValue (foldMap getAmount changeOutputs)
       ]
 
     transactionInfo :: Value -> TagSet
     transactionInfo inputValue =
       TagSet.fromArray $
-        [ "Input Value" `tag` pprintValue inputValue
-        , "Mint Value" `tag` pprintValue (mintValue txBody)
-        , "Fees" `tag` show (txBody ^. _fee)
+        [ "Input Value" `tagSetTag` pprintValue inputValue
+        , "Mint Value" `tagSetTag` pprintValue (mintValue txBody)
+        , "Fees" `tag` BigInt.toString (unwrap (txBody ^. _fee))
         ] <> outputValuesTagSet mChangeOutputs
   in
     except (getInputValue utxos txBody)
-      >>= (flip Logger.trace (message <> ":") <<< transactionInfo)
+      >>= (flip Logger.info (message <> ":") <<< transactionInfo)
diff --git a/src/Internal/Cardano/Types/Transaction.purs b/src/Internal/Cardano/Types/Transaction.purs
@@ -54,6 +54,7 @@ module Ctl.Internal.Cardano.Types.Transaction
   , UnitInterval
   , Update
   , UtxoMap
+  , pprintUtxoMap
   , Vkey(Vkey)
   , Vkeywitness(Vkeywitness)
   , _auxiliaryData
@@ -100,7 +101,7 @@ import Control.Alternative ((<|>))
 import Control.Apply (lift2)
 import Ctl.Internal.Cardano.Types.NativeScript (NativeScript)
 import Ctl.Internal.Cardano.Types.ScriptRef (ScriptRef)
-import Ctl.Internal.Cardano.Types.Value (Coin, NonAdaAsset, Value)
+import Ctl.Internal.Cardano.Types.Value (Coin, NonAdaAsset, Value, pprintValue)
 import Ctl.Internal.Deserialization.FromBytes (fromBytes)
 import Ctl.Internal.Deserialization.Keys
   ( ed25519SignatureFromBech32
@@ -113,6 +114,7 @@ import Ctl.Internal.Serialization.Address
   , NetworkId
   , Slot(Slot)
   , StakeCredential
+  , addressBech32
   )
 import Ctl.Internal.Serialization.Hash
   ( Ed25519KeyHash
@@ -130,16 +132,18 @@ import Ctl.Internal.Serialization.Types (Ed25519Signature, PublicKey) as Seriali
 import Ctl.Internal.ToData (class ToData, toData)
 import Ctl.Internal.Types.Aliases (Bech32String)
 import Ctl.Internal.Types.BigNum (BigNum)
-import Ctl.Internal.Types.ByteArray (ByteArray)
+import Ctl.Internal.Types.ByteArray (ByteArray, byteArrayToHex)
 import Ctl.Internal.Types.Int as Int
-import Ctl.Internal.Types.OutputDatum (OutputDatum)
-import Ctl.Internal.Types.PlutusData (PlutusData)
+import Ctl.Internal.Types.OutputDatum
+  ( OutputDatum(NoOutputDatum, OutputDatumHash, OutputDatum)
+  )
+import Ctl.Internal.Types.PlutusData (PlutusData, pprintPlutusData)
 import Ctl.Internal.Types.PubKeyHash (PaymentPubKeyHash, PubKeyHash(PubKeyHash))
 import Ctl.Internal.Types.RawBytes (RawBytes)
 import Ctl.Internal.Types.RedeemerTag (RedeemerTag)
 import Ctl.Internal.Types.RewardAddress (RewardAddress)
 import Ctl.Internal.Types.Scripts (Language, PlutusScript)
-import Ctl.Internal.Types.Transaction (TransactionInput)
+import Ctl.Internal.Types.Transaction (TransactionInput(TransactionInput))
 import Ctl.Internal.Types.TransactionMetadata (GeneralTransactionMetadata)
 import Ctl.Internal.Types.VRFKeyHash (VRFKeyHash)
 import Data.Array (union)
@@ -150,8 +154,11 @@ import Data.Lens (lens')
 import Data.Lens.Iso.Newtype (_Newtype)
 import Data.Lens.Record (prop)
 import Data.Lens.Types (Lens')
+import Data.Log.Tag (TagSet, tag, tagSetTag)
+import Data.Log.Tag as TagSet
 import Data.Map (Map)
-import Data.Maybe (Maybe(Nothing), fromJust)
+import Data.Map as Map
+import Data.Maybe (Maybe(Just, Nothing), fromJust)
 import Data.Monoid (guard)
 import Data.Newtype (class Newtype, unwrap, wrap)
 import Data.Set (Set)
@@ -160,8 +167,9 @@ import Data.Show.Generic (genericShow)
 import Data.String.Utils (startsWith)
 import Data.Symbol (SProxy(SProxy))
 import Data.Tuple (Tuple(Tuple))
-import Data.Tuple.Nested (type (/\))
+import Data.Tuple.Nested (type (/\), (/\))
 import Data.UInt (UInt)
+import Data.UInt as UInt
 import Partial.Unsafe (unsafePartial)
 
 --------------------------------------------------------------------------------
@@ -967,3 +975,33 @@ instance Show TransactionOutput where
   show = genericShow
 
 type UtxoMap = Map TransactionInput TransactionOutput
+
+pprintUtxoMap :: UtxoMap -> TagSet
+pprintUtxoMap utxos = TagSet.fromArray $
+  Map.toUnfoldable utxos <#>
+    \( TransactionInput { transactionId, index } /\
+         TransactionOutput { address, amount, datum, scriptRef }
+     ) ->
+      let
+        datumTagSets = case datum of
+          NoOutputDatum -> []
+          OutputDatumHash datumHash ->
+            [ TagSet.fromArray
+                [ "datum hash" `tag` byteArrayToHex (unwrap datumHash) ]
+            ]
+          OutputDatum plutusData ->
+            [ TagSet.fromArray
+                [ "datum" `tagSetTag` pprintPlutusData (unwrap plutusData) ]
+            ]
+        scriptRefTagSets = case scriptRef of
+          Nothing -> []
+          Just ref -> [ "Script Reference" `tag` show ref ]
+        outputTagSet =
+          [ "amount" `tagSetTag` pprintValue amount
+          , "address" `tag` addressBech32 address
+          ]
+            <> datumTagSets
+            <> scriptRefTagSets
+      in
+        (byteArrayToHex (unwrap transactionId) <> "#" <> UInt.toString index)
+          `tagSetTag` TagSet.fromArray outputTagSet
diff --git a/src/Internal/Cardano/Types/Value.purs b/src/Internal/Cardano/Types/Value.purs
@@ -97,7 +97,7 @@ import Ctl.Internal.Types.TokenName
   , mkTokenName
   , mkTokenNames
   )
-import Data.Array (cons, filter, intercalate)
+import Data.Array (cons, filter)
 import Data.Array (fromFoldable) as Array
 import Data.Array.NonEmpty (NonEmptyArray)
 import Data.Array.NonEmpty (replicate, singleton, zipWith) as NEArray
@@ -114,6 +114,8 @@ import Data.Int (ceil) as Int
 import Data.Lattice (class JoinSemilattice, class MeetSemilattice, join, meet)
 import Data.List (List(Nil), all, (:))
 import Data.List (nubByEq) as List
+import Data.Log.Tag (TagSet, tag, tagSetTag)
+import Data.Log.Tag as TagSet
 import Data.Map (Map, keys, lookup, toUnfoldable, unions, values)
 import Data.Map as Map
 import Data.Map.Gen (genMap)
@@ -342,13 +344,13 @@ instance Equipartition NonAdaAsset where
         map (mkSingletonNonAdaAsset cs tn)
           (equipartition tokenQuantity numParts)
 
-pprintNonAdaAsset :: NonAdaAsset -> String
-pprintNonAdaAsset mp = intercalate "\n" $
+pprintNonAdaAsset :: NonAdaAsset -> TagSet
+pprintNonAdaAsset mp = TagSet.fromArray $
   Map.toUnfoldable (unwrapNonAdaAsset mp) <#> \(currency /\ tokens) ->
-    byteArrayToHex (getCurrencySymbol currency) <> ":\n" <>
-      ( intercalate "\n" $ Map.toUnfoldable tokens <#> \(tokenName /\ amount) ->
-          "  " <> fromTokenName byteArrayToHex show tokenName <> ": "
-            <> BigInt.toString amount
+    byteArrayToHex (getCurrencySymbol currency) `tagSetTag` TagSet.fromArray
+      ( Map.toUnfoldable tokens <#> \(tokenName /\ amount) ->
+          fromTokenName byteArrayToHex show tokenName `tag` BigInt.toString
+            amount
       )
 
 -- | Partitions a `NonAdaAsset` into smaller `NonAdaAsset`s, where the
@@ -496,10 +498,15 @@ instance Equipartition Value where
       (equipartition coin numParts)
       (equipartition nonAdaAssets numParts)
 
-pprintValue :: Value -> String
-pprintValue value =
-  "ADA: " <> BigInt.toString (unwrap (valueToCoin value)) <> "\n" <>
-    pprintNonAdaAsset (getNonAdaAsset value)
+pprintValue :: Value -> TagSet
+pprintValue value = TagSet.fromArray $
+  [ "ADA" `tag` BigInt.toString (unwrap (valueToCoin value)) ]
+    <>
+      if nonAdaAssets /= mempty then
+        [ "Assets" `tagSetTag` pprintNonAdaAsset nonAdaAssets ]
+      else []
+  where
+  nonAdaAssets = getNonAdaAsset value
 
 -- | Partitions a `Value` into smaller `Value`s, where the Ada amount and the
 -- | quantity of each token is equipartitioned across the resultant `Value`s,

diff --git a/src/Internal/Types/PlutusData.purs b/src/Internal/Types/PlutusData.purs
@@ -6,6 +6,7 @@ module Ctl.Internal.Types.PlutusData
       , Integer
       , Bytes
       )
+  , pprintPlutusData
   ) where
 
 import Prelude
@@ -21,10 +22,14 @@ import Aeson
   )
 import Control.Alt ((<|>))
 import Ctl.Internal.Types.BigNum (BigNum)
-import Ctl.Internal.Types.ByteArray (ByteArray, hexToByteArray)
+import Ctl.Internal.Types.BigNum as BigNum
+import Ctl.Internal.Types.ByteArray (ByteArray, byteArrayToHex, hexToByteArray)
 import Data.BigInt (BigInt)
+import Data.BigInt as BigInt
 import Data.Either (Either(Left))
 import Data.Generic.Rep (class Generic)
+import Data.Log.Tag (TagSet, tag, tagSetTag)
+import Data.Log.Tag as TagSet
 import Data.Maybe (Maybe(Just, Nothing))
 import Data.Show.Generic (genericShow)
 import Data.Traversable (for)
@@ -104,3 +109,25 @@ instance EncodeAeson PlutusData where
   encodeAeson (List elems) = encodeAeson elems
   encodeAeson (Integer bi) = encodeAeson bi
   encodeAeson (Bytes ba) = encodeAeson ba
+
+pprintPlutusData :: PlutusData -> TagSet
+pprintPlutusData (Constr n children) = TagSet.fromArray
+  [ ("Constr " <> BigInt.toString (BigNum.toBigInt n)) `tagSetTag`
+      TagSet.fromArray (pprintPlutusData <$> children)
+  ]
+pprintPlutusData (Map entries) = TagSet.fromArray
+  [ tagSetTag "Map" $ TagSet.fromArray $
+      entries <#> \(key /\ value) ->
+        TagSet.fromArray
+          [ "key" `tagSetTag` pprintPlutusData key
+          , "value" `tagSetTag` pprintPlutusData value
+          ]
+  ]
+pprintPlutusData (List children) = TagSet.fromArray
+  [ tagSetTag "List" $ TagSet.fromArray $
+      children <#> pprintPlutusData
+  ]
+pprintPlutusData (Integer n) = TagSet.fromArray
+  [ "Integer" `tag` BigInt.toString n ]
+pprintPlutusData (Bytes bytes) = TagSet.fromArray
+  [ "Bytes" `tag` byteArrayToHex bytes ]