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.TxOutBinary
     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/TxOutBinary.hs

@@ -0,0 +1,80 @@
+module Cardano.Wallet.DB.Store.DeltaUTxO.TxOutBinary
+    ( serializeTxOut
+    , deserializeTxOut
+    )
+where
+
+import Prelude
+
+import Cardano.Binary
+    ( ByteOffset )
+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 (..) )
+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 (..) )
+import Control.Exception
+    ( Exception )
+import Control.Monad
+    ( replicateM )
+import Data.Binary
+    ( Binary (..), Get, Put, decodeOrFail, encode )
+import Data.Binary.Put
+    ( PutM )
+import Data.ByteString.Lazy
+    ( ByteString )
+
+-- | Signal a failure to decode a 'TxOut' from a ByteString.
+newtype FailedDecodingDeltaUTxO
+    = FailedDecodingDeltaUTxO (ByteString, ByteOffset, String)
+    deriving (Show, Eq)
+
+instance Exception FailedDecodingDeltaUTxO
+
+newtype TxOutBinary = TxOutBinary {_unTxOutBinary :: TxOut}
+
+instance Binary TxOutBinary where
+    put (TxOutBinary (TxOut (Address addr) (TokenBundle (Coin c) m))) = do
+            put (addr, c)
+            putListOf (toFlatList m) $
+                \( AssetId
+                        (UnsafeTokenPolicyId (Hash policy))
+                        (UnsafeTokenName name)
+                    , TokenQuantity quant
+                    ) -> put (policy, name, quant)
+    get = do
+        (addr, c) <- get
+        m <- fmap fromFlatList $ getListOf $ do
+            (policy, name, quant) <- get
+            pure
+                ( AssetId
+                    (UnsafeTokenPolicyId (Hash policy))
+                    (UnsafeTokenName name)
+                , TokenQuantity quant
+                )
+        pure (TxOutBinary (TxOut (Address addr) (TokenBundle (Coin c) m)))
+
+getListOf :: Get a -> Get [a]
+getListOf f = get >>= flip replicateM f
+
+putListOf :: [a] -> (a -> Put) -> PutM ()
+putListOf xs f = put (length xs) >> mapM_ f xs
+
+-- | Read a 'TxOut' from a binary blob.
+deserializeTxOut :: ByteString -> Either (ByteString, ByteOffset, String) TxOut
+deserializeTxOut = fmap (\(_, _, TxOutBinary value) -> value) . decodeOrFail
+
+-- | Write a 'TxOut' to a binary blob.
+serializeTxOut :: TxOut -> ByteString
+serializeTxOut value = encode $ TxOutBinary value