diff --git a/.travis.yml b/.travis.yml index 08e039ab356..b5ef99fa210 100644 --- a/.travis.yml +++ b/.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 🔨 diff --git a/lib/core/src/Cardano/Wallet/Primitive/Types.hs b/lib/core/src/Cardano/Wallet/Primitive/Types.hs index 5779af77db4..9c61c02a44f 100644 --- a/lib/core/src/Cardano/Wallet/Primitive/Types.hs +++ b/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 diff --git a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs b/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs index 1c1a28c461e..bf0ffd9afe8 100644 --- a/lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs +++ b/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 diff --git a/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs b/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs index 28cb67076ab..98f1f3ddfe5 100644 --- a/lib/core/test/unit/Cardano/Wallet/Primitive/ModelSpec.hs +++ b/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 } ] diff --git a/lib/http-bridge/src/Cardano/Wallet/HttpBridge/Compatibility.hs b/lib/http-bridge/src/Cardano/Wallet/HttpBridge/Compatibility.hs index 2f02d0ab84a..ac7bdd903e6 100644 --- a/lib/http-bridge/src/Cardano/Wallet/HttpBridge/Compatibility.hs +++ b/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'. diff --git a/lib/jormungandr/cardano-wallet-jormungandr.cabal b/lib/jormungandr/cardano-wallet-jormungandr.cabal index 18af26f24ca..1588528f42b 100644 --- a/lib/jormungandr/cardano-wallet-jormungandr.cabal +++ b/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 diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs index 9dd426f2a4f..de06ad94295 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Binary.hs +++ b/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 diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Compatibility.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Compatibility.hs index 392dcd2efcb..6f91cf9adf9 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Compatibility.hs +++ b/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: diff --git a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs b/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs index c37794f6638..c468567b342 100644 --- a/lib/jormungandr/src/Cardano/Wallet/Jormungandr/Network.hs +++ b/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. diff --git a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/BinarySpec.hs b/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/BinarySpec.hs index 474d40c1ddb..4135ed1b20f 100644 --- a/lib/jormungandr/test/unit/Cardano/Wallet/Jormungandr/BinarySpec.hs +++ b/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,6 +22,7 @@ import Cardano.Wallet.Jormungandr.Binary , getBlock , getBlockHeader , runGet + , singleAddressFromKey ) import Cardano.Wallet.Jormungandr.Compatibility ( genesis ) @@ -26,6 +30,8 @@ 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. 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 "" 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 } ]