Merge pull request #362 from input-output-hk/akegalj/219/serialize_tx

Add initial support for serializing signed transaction
cardano-foundation · Jun 14, 2019 · 021f02f · 021f02f
2 parents cb7744e + ff9e902
commit 021f02f
Show file tree

Hide file tree

Showing 2 changed files with 57 additions and 8 deletions.
diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api.hs
@@ -25,7 +25,7 @@ import Prelude
 import Cardano.Wallet.Jormungandr.Binary
     ( FromBinary (..), runGet )
 import Cardano.Wallet.Primitive.Types
-    ( Block, Hash (..) )
+    ( Block, Hash (..), Tx, TxWitness )
 import Data.Binary.Get
     ( getByteString )
 import Data.ByteArray.Encoding
@@ -91,13 +91,10 @@ type GetTipId
 
 type PostSignedTx
     = "v0"
-    :> "transaction"
-    :> ReqBody '[JormungandrBinary] SignedTx
+    :> "message"
+    :> ReqBody '[JormungandrBinary] (Tx, [TxWitness])
     :> Post '[NoContent] NoContent
 
--- TODO: Replace SignedTx with something real
-data SignedTx
-
 newtype BlockId = BlockId (Hash "BlockHeader")
     deriving (Eq, Show)
 

diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs
@@ -3,6 +3,8 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 -- |
 -- Copyright: © 2018-2019 IOHK
@@ -19,6 +21,8 @@ module Cardano.Wallet.Jormungandr.Binary
     , getBlockHeader
     , getBlock
 
+    , putTransaction
+
     , ConfigParam (..)
     , ConsensusVersion (..)
     , LeaderId (..)
@@ -40,7 +44,7 @@ module Cardano.Wallet.Jormungandr.Binary
 import Prelude
 
 import Cardano.Wallet.Jormungandr.Environment
-    ( Network (..) )
+    ( KnownNetwork (..), Network (..) )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
     , Coin (..)
@@ -67,10 +71,14 @@ import Data.Binary.Get
     , runGet
     , skip
     )
+import Data.Binary.Put
+    ( Put, putByteString, putWord64be, putWord8 )
 import Data.Bits
     ( shift, (.&.) )
 import Data.ByteString
     ( ByteString )
+import Data.Proxy
+    ( Proxy (..) )
 import Data.Quantity
     ( Quantity (..) )
 import Data.Word
@@ -216,10 +224,54 @@ getTransaction = label "getTransaction" $ isolate 43 $ do
                 error "unimplemented: Account witness"
             other -> fail $ "Invalid witness type: " ++ show other
 
+
+putTransaction :: forall n. KnownNetwork n => Proxy n -> (Tx, [TxWitness]) -> Put
+putTransaction _ (tx, witnesses) = do
+    putTokenTransfer (Proxy @n) tx
+    mapM_ putWitness witnesses
+
+putWitness :: TxWitness -> Put
+putWitness witness =
+    case witness of
+        PublicKeyWitness xPub (Hash sig) -> do
+            -- Witness sum type:
+            --   * 1 for old address witnness scheme
+            --   * 2 for new address witness scheme
+            --   * 3 for account witness
+            putWord8 1
+            putByteString xPub
+            putByteString sig
+        -- TODO: note that we are missing new address type witness:
+        --  * https://github.com/input-output-hk/rust-cardano/blob/3524cfe138a10773caa6f0effacf69e792f915df/chain-impl-mockchain/doc/format.md#witnesses
+        --  * https://github.com/input-output-hk/rust-cardano/blob/e0616f13bebd6b908320bddb1c1502dea0d3305a/chain-impl-mockchain/src/transaction/witness.rs#L23
+        ScriptWitness _ -> error "unimplemented: serialize script witness"
+        RedeemWitness _ -> error "unimplemented: serialize redeem witness"
+
+
 {-------------------------------------------------------------------------------
                             Common Structure
 -------------------------------------------------------------------------------}
 
+putTokenTransfer :: forall n. KnownNetwork n => Proxy n -> Tx -> Put
+putTokenTransfer _ (Tx inputs outputs) = do
+    putWord8 $ fromIntegral $ length inputs
+    putWord8 $ fromIntegral $ length outputs
+    mapM_ putInput inputs
+    mapM_ putOutput outputs
+  where
+    putInput (TxIn inputId inputIx) = do
+        -- NOTE: special value 0xff indicates account spending
+        -- only old utxo/address scheme supported for now
+        putWord8 $ fromIntegral inputIx
+        putByteString $ getHash inputId
+    putOutput (TxOut address coin) = do
+        putAddress address
+        putWord64be $ getCoin coin
+    putAddress address = do
+        -- NOTE: only single address supported for now
+        putWord8 (single @n)
+        putByteString $ getAddress address
+
 getTokenTransfer :: Get ([TxIn], [TxOut])
 getTokenTransfer = label "getTokenTransfer" $ do
     inCount <- fromIntegral <$> getWord8
@@ -232,7 +284,6 @@ getTokenTransfer = label "getTokenTransfer" $ do
         -- NOTE: special value 0xff indicates account spending
         index <- fromIntegral <$> getWord8
         tx <- Hash <$> getByteString 32
-
         return $ TxIn tx index
 
     getOutput = do
@@ -260,6 +311,7 @@ getTokenTransfer = label "getTokenTransfer" $ do
         0 -> Mainnet
         _ -> Testnet
 
+
 {-------------------------------------------------------------------------------
                             Config Parameters
 -------------------------------------------------------------------------------}