Add binary codec for TxOut.

lib/wallet/cardano-wallet.cabal

@@ -238,6 +238,7 @@ library
     Cardano.Wallet.DB.Store.Checkpoints
     Cardano.Wallet.DB.Store.DeltaUTxO.Model
     Cardano.Wallet.DB.Store.DeltaUTxO.Model.Internal
+    Cardano.Wallet.DB.Store.DeltaUTxO.TxOutCBOR
     Cardano.Wallet.DB.Store.DeltaUTxO.Store
     Cardano.Wallet.DB.Store.Meta.Model
     Cardano.Wallet.DB.Store.Meta.Store

lib/wallet/src/Cardano/Wallet/DB/Store/DeltaUTxO/TxOutCBOR.hs

@@ -0,0 +1,107 @@
+module Cardano.Wallet.DB.Store.DeltaUTxO.TxOutCBOR
+    ( serializeTxOut
+    , deserializeTxOut
+    )
+where
+
+import Prelude
+
+import Cardano.Wallet.Primitive.Types.Address
+    ( Address (..) )
+import Cardano.Wallet.Primitive.Types.Coin
+    ( Coin (..) )
+import Cardano.Wallet.Primitive.Types.Hash
+    ( Hash (..) )
+import Cardano.Wallet.Primitive.Types.TokenBundle
+    ( TokenBundle (TokenBundle) )
+import Cardano.Wallet.Primitive.Types.TokenMap
+    ( AssetId (AssetId), fromFlatList, toFlatList )
+import Cardano.Wallet.Primitive.Types.TokenPolicy
+    ( TokenName (UnsafeTokenName), TokenPolicyId (UnsafeTokenPolicyId) )
+import Cardano.Wallet.Primitive.Types.TokenQuantity
+    ( TokenQuantity (TokenQuantity) )
+import Cardano.Wallet.Primitive.Types.Tx.TxOut
+    ( TxOut (TxOut) )
+import Codec.CBOR.Decoding
+    ( Decoder, decodeBytes, decodeInteger, decodeListLen )
+import Codec.CBOR.Encoding
+    ( Encoding, encodeBytes, encodeInteger, encodeListLen )
+import Codec.CBOR.Read
+    ( deserialiseFromBytes )
+import Codec.CBOR.Write
+    ( toLazyByteString )
+import Codec.Serialise
+    ( DeserialiseFailure )
+import Control.Exception
+    ( Exception )
+import Control.Monad
+    ( replicateM )
+import Data.ByteString.Lazy
+    ( ByteString )
+
+-- | Signal a failure to decode a 'TxOut' from a ByteString.
+data FailedDecodingDeltaUTxO
+    = FailedPatternMatching String
+    | FailedDecoding DeserialiseFailure
+    deriving (Show, Eq)
+
+instance Exception FailedDecodingDeltaUTxO
+
+encodeTxOut :: TxOut -> Encoding
+encodeTxOut (TxOut (Address addr) (TokenBundle (Coin c) m)) =
+    encodeListLen 3
+        <> encodeBytes addr
+        <> encodeInteger (fromIntegral c)
+        <> let tokens = toFlatList m
+            in encodeListLen (fromIntegral $ length tokens)
+                <> foldMap
+                    ( \( AssetId
+                            (UnsafeTokenPolicyId (Hash policy))
+                            (UnsafeTokenName name)
+                        , TokenQuantity quant
+                        ) ->
+                            encodeListLen 3
+                                <> encodeBytes policy
+                                <> encodeBytes name
+                                <> encodeInteger (fromIntegral quant)
+                    )
+                    tokens
+
+decodeTxOut :: Decoder s TxOut
+decodeTxOut = do
+    len <- decodeListLen
+    case len of
+        3 -> do
+            addr <- decodeBytes
+            c <- decodeInteger
+            tokensLen <- decodeListLen
+            tokens <- replicateM tokensLen $ do
+                len' <- decodeListLen
+                case len' of
+                    3 -> do
+                        policy <- decodeBytes
+                        name <- decodeBytes
+                        quant <- decodeInteger
+                        return
+                            ( AssetId
+                                (UnsafeTokenPolicyId (Hash policy))
+                                (UnsafeTokenName name)
+                            , TokenQuantity $
+                                fromIntegral quant
+                            )
+                    _ -> fail $ "decodeTxOut: expected 3, got " ++ show len
+            return $
+                TxOut
+                    (Address addr)
+                    ( TokenBundle (Coin $ fromIntegral c) $
+                        fromFlatList tokens
+                    )
+        _ -> fail $ "decodeTxOut: expected 3, got " ++ show len
+
+-- | Read a 'TxOut' from a binary blob.
+deserializeTxOut :: ByteString -> Either DeserialiseFailure TxOut
+deserializeTxOut = fmap snd . deserialiseFromBytes decodeTxOut
+
+-- | Write a 'TxOut' to a binary blob.
+serializeTxOut :: TxOut -> ByteString
+serializeTxOut = toLazyByteString . encodeTxOut