Jörmungandr: Separate concern between keyToAddress and get/putAddress

.travis.yml

@@ -142,8 +142,8 @@ jobs:
     if: (type != pull_request AND branch = master) OR (tag =~ ^v)
     name: "Caching Dependencies"
     script:
-    - stack --no-terminal build --fast --only-snapshot
-    - stack --no-terminal build --fast --only-dependencies
+    - stack --no-terminal build --fast --test --no-run-tests --bench --no-run-benchmarks --only-snapshot
+    - stack --no-terminal build --fast --test --no-run-tests --bench --no-run-benchmarks --only-dependencies
     - tar czf $STACK_WORK_CACHE .stack-work
 
   - stage: build project 🔨

lib/core/src/Cardano/Wallet/Primitive/Types.hs

@@ -527,7 +527,7 @@ isPending = (== Pending) . (status :: TxMeta -> TxStatus) . snd
 -- layer and that the underlying encoding is rather agnostic to the underlying
 -- backend.
 newtype Address = Address
-    { getAddress :: ByteString
+    { unAddress :: ByteString
     } deriving (Show, Generic, Eq, Ord)
 
 instance NFData Address
@@ -538,7 +538,7 @@ instance Buildable Address where
 instance ToText Address where
     toText = T.decodeUtf8
         . convertToBase Base16
-        . getAddress
+        . unAddress
 
 instance FromText Address where
     fromText = bimap textDecodingError Address

lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -495,7 +495,7 @@ instance Arbitrary (Proxy DummyTarget) where
     arbitrary = pure Proxy
 
 instance EncodeAddress DummyTarget where
-    encodeAddress _ = T.decodeUtf8 . convertToBase Base16 . getAddress
+    encodeAddress _ = T.decodeUtf8 . convertToBase Base16 . unAddress
 
 instance DecodeAddress DummyTarget where
     decodeAddress _ = bimap decodingError Address

lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs

@@ -539,7 +539,7 @@ blockchain =
                     ]
                 , outputs =
                     [ TxOut
-                        { address = Address { getAddress = "\130\216\CANXB\131X\FS!\148\NULDcB\r\237\202\255)\DLEe`\159\a\\-IG\"P\218\136\219i\244\134\161\SOHX\RSX\FS\202>U<\156c\197;\236\EOT\STXC\209\173\138\205B\EOT.\ENQ\ACKG@\174\206\185\ESC\206\NUL\SUB\230\150\192\165" }
+                        { address = Address { unAddress = "\130\216\CANXB\131X\FS!\148\NULDcB\r\237\202\255)\DLEe`\159\a\\-IG\"P\218\136\219i\244\134\161\SOHX\RSX\FS\202>U<\156c\197;\236\EOT\STXC\209\173\138\205B\EOT.\ENQ\ACKG@\174\206\185\ESC\206\NUL\SUB\230\150\192\165" }
                         , coin = Coin 3824424245549
                         }
                     , TxOut
@@ -634,7 +634,7 @@ blockchain =
                         , coin = Coin 3827577253906
                         }
                     , TxOut
-                        { address = Address { getAddress = "\130\216\CANXB\131X\FS\167\219!{\ETX\157lP>i~\158\225\DEL\141!.I\248\"\183(\DC13\231\185pU\161\SOHX\RSX\FS\SOH\131\136&\ESC\236\240\200\rw\255.\153\252\&6'\174\159vs\CAN\255\153\USf\155\173\223\NUL\SUB\214\237\RS\248" }
+                        { address = Address "\130\216\CANXB\131X\FS\167\219!{\ETX\157lP>i~\158\225\DEL\141!.I\248\"\183(\DC13\231\185pU\161\SOHX\RSX\FS\SOH\131\136&\ESC\236\240\200\rw\255.\153\252\&6'\174\159vs\CAN\255\153\USf\155\173\223\NUL\SUB\214\237\RS\248"
                         , coin = Coin 16837395907
                         }
                     ]
@@ -764,7 +764,7 @@ blockchain =
                         , coin = Coin 3832107959251
                         }
                     , TxOut
-                        { address = Address { getAddress = "\130\216\CANXB\131X\FSI\SI\165\f\DLE\223\214\209\206\187y\128F\SUB\248.\203\186/\244\143m1]\n\132\234\"\161\SOHX\RSX\FSv\SI\240\133L\130\194\DC2\191}\189;5\141\252t]\132}[\244\ESC&\SI\EOT[{\238\NUL\SUB\159\236eZ" }
+                        { address = Address "\130\216\CANXB\131X\FSI\SI\165\f\DLE\223\214\209\206\187y\128F\SUB\248.\203\186/\244\143m1]\n\132\234\"\161\SOHX\RSX\FSv\SI\240\133L\130\194\DC2\191}\189;5\141\252t]\132}[\244\ESC&\SI\EOT[{\238\NUL\SUB\159\236eZ"
                         , coin = Coin 11823271860
                         }
                     ]

lib/http-bridge/src/Cardano/Wallet/HttpBridge/Compatibility.hs

@@ -107,7 +107,7 @@ emptyAttributes = CBOR.encodeMapLen 0
 --
 -- [Base58](https://en.wikipedia.org/wiki/Base58)
 instance EncodeAddress (HttpBridge (network :: Network)) where
-    encodeAddress _ = T.decodeUtf8 . encodeBase58 bitcoinAlphabet . getAddress
+    encodeAddress _ = T.decodeUtf8 . encodeBase58 bitcoinAlphabet . unAddress
 
 -- | Decode a [Base58](https://en.wikipedia.org/wiki/Base58) text string to an
 -- 'Address'.

lib/jormungandr/cardano-wallet-jormungandr.cabal

@@ -37,6 +37,7 @@ library
     , binary
     , bytestring
     , cardano-wallet-core
+    , cardano-crypto
     , cborg
     , exceptions
     , http-client
@@ -75,6 +76,7 @@ test-suite unit
       base
     , bytestring
     , cardano-wallet-core
+    , cardano-crypto
     , cardano-wallet-jormungandr
     , generic-arbitrary
     , generic-lens

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs

@@ -20,6 +20,7 @@ module Cardano.Wallet.Jormungandr.Binary
     , Message (..)
     , getBlockHeader
     , getBlock
+    , getTransaction
 
     , putTransaction
 
@@ -29,6 +30,11 @@ module Cardano.Wallet.Jormungandr.Binary
     , LinearFee (..)
     , Milli (..)
 
+    -- * Addresses
+    , putAddress
+    , getAddress
+    , singleAddressFromKey
+
       -- * Classes
     , FromBinary (..)
 
@@ -43,8 +49,10 @@ module Cardano.Wallet.Jormungandr.Binary
 
 import Prelude
 
+import Cardano.Crypto.Wallet
+    ( XPub (xpubPublicKey) )
 import Cardano.Wallet.Jormungandr.Environment
-    ( KnownNetwork (..), Network (..) )
+    ( KnownNetwork, Network (..), single )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
     , Coin (..)
@@ -68,11 +76,12 @@ import Data.Binary.Get
     , isEmpty
     , isolate
     , label
+    , lookAhead
     , runGet
     , skip
     )
 import Data.Binary.Put
-    ( Put, putByteString, putWord64be, putWord8 )
+    ( Put, putByteString, putLazyByteString, putWord64be, putWord8, runPut )
 import Data.Bits
     ( shift, (.&.) )
 import Data.ByteString
@@ -87,6 +96,7 @@ import Data.Word
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Codec.CBOR.Decoding as CBOR
 import qualified Codec.CBOR.Read as CBOR
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
 
 data BlockHeader = BlockHeader
@@ -199,7 +209,7 @@ getInitial = label "getInitial" $ do
 
 -- | Decode the contents of a @Transaction@-message.
 getTransaction :: Get Tx
-getTransaction = label "getTransaction" $ isolate 43 $ do
+getTransaction = label "getTransaction" $ do
     (ins, outs) <- getTokenTransfer
 
     let witnessCount = length ins
@@ -224,10 +234,9 @@ 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
+putTransaction :: (Tx, [TxWitness]) -> Put
+putTransaction (tx, witnesses) = do
+    putTokenTransfer tx
     mapM_ putWitness witnesses
 
 putWitness :: TxWitness -> Put
@@ -252,8 +261,8 @@ putWitness witness =
                             Common Structure
 -------------------------------------------------------------------------------}
 
-putTokenTransfer :: forall n. KnownNetwork n => Proxy n -> Tx -> Put
-putTokenTransfer _ (Tx inputs outputs) = do
+putTokenTransfer :: Tx -> Put
+putTokenTransfer (Tx inputs outputs) = do
     putWord8 $ fromIntegral $ length inputs
     putWord8 $ fromIntegral $ length outputs
     mapM_ putInput inputs
@@ -267,10 +276,6 @@ putTokenTransfer _ (Tx inputs outputs) = do
     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
@@ -291,25 +296,7 @@ getTokenTransfer = label "getTokenTransfer" $ do
         value <- Coin <$> getWord64be
         return $ TxOut addr value
 
-    getAddress = do
-        headerByte <- getWord8
-        let kind = kindValue headerByte
-        let _discrimination = discriminationValue headerByte
-        case kind of
-            -- Single Address
-            0x3 -> Address <$> getByteString 32
-            0x4 -> error "unimplemented group address decoder"
-            0x5 -> error "unimplemented account address decoder"
-            0x6 -> error "unimplemented multisig address decoder"
-            other -> fail $ "Invalid address type: " ++ show other
-
-    kindValue :: Word8 -> Word8
-    kindValue = (.&. 0b01111111)
 
-    discriminationValue :: Word8 -> Network
-    discriminationValue b = case b .&. 0b10000000 of
-        0 -> Mainnet
-        _ -> Testnet
 
 
 {-------------------------------------------------------------------------------
@@ -430,10 +417,63 @@ getBool = getWord8 >>= \case
     other -> fail $ "Unexpected integer: " ++ show other
                 ++ ". Expected a boolean 0 or 1."
 
+
+{-------------------------------------------------------------------------------
+                            Addresses
+-------------------------------------------------------------------------------}
+
+getAddress :: Get Address
+getAddress = do
+    -- We use 'lookAhead' to not consume the header, and let it
+    -- be included in the underlying Address ByteString.
+    headerByte <- label "address header" . lookAhead $ getWord8
+    let kind = kindValue headerByte
+    let _discrimination = discriminationValue headerByte
+    case kind of
+        0x3 -> Address <$> getByteString 33 -- single address
+        0x4 -> Address <$> getByteString 65 -- grouped address
+        0x5 -> Address <$> getByteString 65 -- account address
+        0x6 -> Address <$> getByteString 33 -- multisig address
+        other -> fail $ "Invalid address type: " ++ show other
+  where
+    kindValue :: Word8 -> Word8
+    kindValue = (.&. 0b01111111)
+
+    discriminationValue :: Word8 -> Network
+    discriminationValue b = case b .&. 0b10000000 of
+        0 -> Mainnet
+        _ -> Testnet
+
+putAddress :: Address -> Put
+putAddress addr@(Address bs)
+    | l == 33 = putByteString bs -- bootstrap or account addr
+    | l == 65 = putByteString bs -- delegation addr
+    | otherwise = fail
+        $ "Address have unexpected length "
+        ++ (show l)
+        ++ ": " ++ show addr
+  where l = BS.length bs
+
+singleAddressFromKey :: forall n. KnownNetwork n => Proxy n -> XPub -> Address
+singleAddressFromKey _ xPub = Address $ BL.toStrict $ runPut $ do
+    putWord8 (single @n)
+    isolatePut 32 $ putByteString (xpubPublicKey xPub )
+
 {-------------------------------------------------------------------------------
                               Helpers
 -------------------------------------------------------------------------------}
 
+-- | Make sure a 'Put' encodes into a specific length
+isolatePut :: Int -> Put -> Put
+isolatePut l x = do
+    let bs = runPut x
+    if BL.length bs == (fromIntegral l)
+    then putLazyByteString bs
+    else fail $ "length was "
+        ++ show (BL.length bs)
+        ++ ", but expected to be "
+        ++ (show l)
+
 whileM :: Monad m => m Bool -> m a -> m [a]
 whileM cond next = go
   where

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Compatibility.hs

@@ -23,11 +23,11 @@ module Cardano.Wallet.Jormungandr.Compatibility
 import Prelude
 
 import Cardano.Wallet.Jormungandr.Binary
-    ( decodeLegacyAddress )
+    ( decodeLegacyAddress, singleAddressFromKey )
 import Cardano.Wallet.Jormungandr.Environment
     ( KnownNetwork (..), Network (..) )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( KeyToAddress (..) )
+    ( KeyToAddress (..), getKey )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
     , BlockHeader (..)
@@ -47,6 +47,8 @@ import Data.ByteString.Base58
     ( bitcoinAlphabet, decodeBase58, encodeBase58 )
 import Data.Maybe
     ( isJust )
+import Data.Proxy
+    ( Proxy (..) )
 import Data.Text.Class
     ( TextDecodingError (..) )
 
@@ -69,8 +71,9 @@ genesis = BlockHeader
 instance TxId (Jormungandr n) where
     txId = undefined
 
-instance KeyToAddress (Jormungandr n) where
-    keyToAddress = undefined
+instance forall n. KnownNetwork n => KeyToAddress (Jormungandr n) where
+    keyToAddress key = singleAddressFromKey (Proxy @n) (getKey key)
+
 
 -- | Encode an 'Address' to a human-readable format. This produces two kinds of
 -- encodings:

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs

@@ -151,7 +151,7 @@ data JormungandrLayer m = JormungandrLayer
 --
 -- >>> (Right block) <- runExceptT $ getBlock j t
 -- >>> block
--- >>> Block {header = BlockHeader {slotId = SlotId {epochNumber = 0, slotNumber = 0}, prevBlockHash = Hash {getHash = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL"}}, transactions = [Tx {inputs = [], outputs = [TxOut {address = Address {getAddress = "3$\195xi\193\"h\154\&5\145}\245:O\"\148\163\165/h^\ENQ\245\248\229;\135\231\234E/"}, coin = Coin {getCoin = 14}}]}]}
+-- >>> Block {header = BlockHeader {slotId = SlotId {epochNumber = 0, slotNumber = 0}, prevBlockHash = Hash {getHash = "\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL"}}, transactions = [Tx {inputs = [], outputs = [TxOut {address = Address {unAddress = "3$\195xi\193\"h\154\&5\145}\245:O\"\148\163\165/h^\ENQ\245\248\229;\135\231\234E/"}, coin = Coin {getCoin = 14}}]}]}
 --
 -- At the time of writing, we only have the genesis-block, but we should be
 -- able to get its descendants.

lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/BinarySpec.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedLabels #-}
 {-# LANGUAGE RankNTypes #-}
@@ -7,6 +8,8 @@ module Cardano.Wallet.Jormungandr.BinarySpec (spec) where
 
 import Prelude
 
+import Cardano.Crypto.Wallet
+    ( ChainCode (..), XPub (..) )
 import Cardano.Wallet.Jormungandr.Binary
     ( Block (..)
     , BlockHeader (..)
@@ -19,13 +22,16 @@ import Cardano.Wallet.Jormungandr.Binary
     , getBlock
     , getBlockHeader
     , runGet
+    , singleAddressFromKey
     )
 import Cardano.Wallet.Jormungandr.Compatibility
     ( genesis )
 import Cardano.Wallet.Jormungandr.Environment
     ( Network (..) )
 import Cardano.Wallet.Primitive.Types
     ( Address (..), Coin (..), Hash (..), SlotId (..), Tx (..), TxOut (..) )
+import Control.Exception
+    ( evaluate )
 import Data.ByteArray.Encoding
     ( Base (Base16), convertFromBase )
 import Data.ByteString
@@ -34,11 +40,14 @@ import Data.Generics.Internal.VL.Lens
     ( (^.) )
 import Data.Generics.Labels
     ()
+import Data.Proxy
+    ( Proxy (..) )
 import Data.Quantity
     ( Quantity (..) )
 import Test.Hspec
-    ( Spec, describe, it, runIO, shouldBe )
+    ( Spec, anyErrorCall, describe, it, runIO, shouldBe, shouldThrow )
 
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
 
 {-# ANN spec ("HLint: ignore Use head" :: String) #-}
@@ -71,6 +80,18 @@ spec = do
                     , parentHeaderHash = Hash {getHash = "\216OY\rX\199\234\188.<O\\\244Y\211\210\254\224`i\216\DC3\167\132\139\154\216\161T\174\247\155"}
                     }
                 []
+    describe "singleAddressFromKey" $ do
+        let pub = "3$\195xi\193\"h\154\&5\145}\245:O\"\148\163\165/h^\ENQ\245\248\229;\135\231\234E/"
+        let singleAddrOnMainnet = 0x3
+        it "encodes (network <> tag <> key) correctly into an address" $
+            singleAddressFromKey (Proxy @'Mainnet) (XPub pub cc)
+            `shouldBe`
+            Address (BS.pack [singleAddrOnMainnet] <> pub)
+        it "throws when length (key) != 32" $
+            evaluate (singleAddressFromKey (Proxy @'Mainnet) (XPub "\148" cc))
+            `shouldThrow` anyErrorCall
+  where
+    cc = ChainCode "<ChainCode is not used by singleAddressToKey>"
 
 genesisHeader :: BlockHeader
 genesisHeader = BlockHeader
@@ -102,7 +123,7 @@ genesisBlock = Block genesisHeader
         { inputs = []
         , outputs =
             [ TxOut
-                { address = Address "3$\195xi\193\"h\154\&5\145}\245:O\"\148\163\165/h^\ENQ\245\248\229;\135\231\234E/"
+                { address = Address "\131\&3$\195xi\193\"h\154\&5\145}\245:O\"\148\163\165/h^\ENQ\245\248\229;\135\231\234E/"
                 , coin = Coin 14
                 }
             ]