Try #1746:

lib/shelley/cardano-wallet-shelley.cabal

@@ -32,13 +32,17 @@ library
       base
     , aeson
     , async
+    , base58-bytestring
+    , bech32
+    , bech32-th
     , bytestring
     , cardano-addresses
     , cardano-api
     , cardano-binary
     , cardano-config
     , cardano-crypto
     , cardano-crypto-class
+    , cardano-ledger
     , cardano-slotting
     , cardano-wallet-cli
     , cardano-wallet-core
@@ -128,6 +132,9 @@ test-suite unit
     ghc-options: -O2 -Werror
   build-depends:
       base
+    , base58-bytestring
+    , bech32
+    , bech32-th
     , bytestring
     , cardano-addresses
     , cardano-crypto-class

lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs

@@ -6,6 +6,8 @@
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
@@ -87,25 +89,31 @@ import Cardano.Slotting.Slot
 import Cardano.Wallet.Api.Types
     ( DecodeAddress (..), EncodeAddress (..) )
 import Cardano.Wallet.Primitive.AddressDerivation
-    ( NetworkDiscriminant (..), hex )
+    ( NetworkDiscriminant (..) )
 import Cardano.Wallet.Unsafe
     ( unsafeDeserialiseCbor )
-import Control.Arrow
-    ( left )
+import Codec.Binary.Bech32
+    ( dataPartFromBytes, dataPartToBytes )
+import Control.Applicative
+    ( (<|>) )
+import Control.Monad
+    ( when )
 import Crypto.Hash.Algorithms
     ( Blake2b_256 (..) )
 import Data.ByteArray.Encoding
     ( Base (Base16), convertFromBase )
 import Data.ByteString
     ( ByteString )
+import Data.ByteString.Base58
+    ( bitcoinAlphabet, decodeBase58, encodeBase58 )
 import Data.Coerce
     ( coerce )
 import Data.Foldable
     ( toList )
 import Data.Map.Strict
     ( Map )
 import Data.Maybe
-    ( fromMaybe, mapMaybe )
+    ( fromMaybe, isJust, mapMaybe )
 import Data.Quantity
     ( Quantity (..), mkPercentage )
 import Data.Text
@@ -155,7 +163,11 @@ import Ouroboros.Network.Point
     ( WithOrigin (..) )
 
 import qualified Cardano.Api as Cardano
+import qualified Cardano.Byron.Codec.Cbor as CBOR
+import qualified Cardano.Chain.Common as Byron
 import qualified Cardano.Wallet.Primitive.Types as W
+import qualified Codec.Binary.Bech32 as Bech32
+import qualified Codec.Binary.Bech32.TH as Bech32
 import qualified Crypto.Hash as Crypto
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString as BS
@@ -658,31 +670,88 @@ toStakePoolDlgCert xpub (W.PoolId pid) =
 -------------------------------------------------------------------------------}
 
 instance EncodeAddress 'Mainnet where
-    encodeAddress = T.decodeUtf8 . hex . W.unAddress
+    encodeAddress = _encodeAddress
 
 instance EncodeAddress ('Testnet pm) where
-    encodeAddress = T.decodeUtf8 . hex . W.unAddress
+    encodeAddress = _encodeAddress
 
-_decodeAddress :: Text -> Either TextDecodingError W.Address
-_decodeAddress x = validateWithLedger =<< W.Address <$> fromHex x
+_encodeAddress :: W.Address -> Text
+_encodeAddress (W.Address bytes) =
+    if isJust (CBOR.deserialiseCbor CBOR.decodeAddressPayload bytes)
+        then base58
+        else bech32
   where
-    fromHex :: Text -> Either TextDecodingError ByteString
-    fromHex =
-        left (const $ TextDecodingError "Unable to decode Address: not valid hex encoding.")
-        .  convertFromBase @ByteString @ByteString Base16
-        . T.encodeUtf8
-
-    validateWithLedger addr@(W.Address bytes) =
-        case SL.deserialiseAddr @TPraosStandardCrypto bytes of
-            Just _ -> Right addr
-            Nothing -> Left $ TextDecodingError
-                "Unable to decode Address: not a well-formed Shelley Address."
+    base58 = T.decodeUtf8 $ encodeBase58 bitcoinAlphabet bytes
+    bech32 = Bech32.encodeLenient hrp (dataPartFromBytes bytes)
+    hrp = [Bech32.humanReadablePart|addr|]
 
 instance DecodeAddress 'Mainnet where
-    decodeAddress = _decodeAddress
+    decodeAddress = _decodeAddress SL.Mainnet
 
 instance DecodeAddress ('Testnet pm) where
-    decodeAddress = _decodeAddress
+    decodeAddress = _decodeAddress SL.Testnet
+
+-- Note that for 'Byron', we always assume no discrimination. In
+-- practice, there is one discrimination for 'Shelley' addresses, and one for
+-- 'Byron' addresses. Yet, on Mainnet, 'Byron' addresses have no explicit
+-- discrimination.
+_decodeAddress
+    :: SL.Network
+    -> Text
+    -> Either TextDecodingError W.Address
+_decodeAddress serverNetwork text =
+    case tryBase16 <|> tryBech32 <|> tryBase58 of
+        Just bytes ->
+            decodeShelleyAddress bytes
+        _ ->
+            Left $ TextDecodingError
+                "Unrecognized address encoding: must be either bech32, base58 or base16"
+  where
+    -- | Attempt decoding an 'Address' using a Bech32 encoding.
+    tryBech32 :: Maybe ByteString
+    tryBech32 = do
+        (_, dp) <- either (const Nothing) Just (Bech32.decodeLenient text)
+        dataPartToBytes dp
+
+    -- | Attempt decoding a legacy 'Address' using a Base58 encoding.
+    tryBase58 :: Maybe ByteString
+    tryBase58 =
+        decodeBase58 bitcoinAlphabet (T.encodeUtf8 text)
+
+    -- | Attempt decoding an 'Address' using Base16 encoding
+    tryBase16 :: Maybe ByteString
+    tryBase16 =
+        either (const Nothing) Just $ convertFromBase Base16 (T.encodeUtf8 text)
+
+    decodeShelleyAddress :: ByteString -> Either TextDecodingError W.Address
+    decodeShelleyAddress bytes = do
+        case SL.deserialiseAddr @TPraosStandardCrypto bytes of
+            Just (SL.Addr addrNetwork _ _) -> do
+                guardNetwork addrNetwork
+                pure (W.Address bytes)
+
+            Just (SL.AddrBootstrap addr) -> do
+                guardNetwork (toNetwork (Byron.addrNetworkMagic addr))
+                pure (W.Address bytes)
+
+            Nothing -> Left $ TextDecodingError
+                "Unable to decode address: not a well-formed Shelley nor Byron address."
+
+      where
+        guardNetwork :: SL.Network -> Either TextDecodingError ()
+        guardNetwork addrNetwork =
+            when (addrNetwork /= serverNetwork) $
+                Left $ TextDecodingError $
+                    "Invalid network discrimination on address. Expecting "
+                    <> show serverNetwork
+                    <> " but got "
+                    <> show addrNetwork
+                    <> "."
+
+        toNetwork :: Byron.NetworkMagic -> SL.Network
+        toNetwork = \case
+            Byron.NetworkMainOrStage -> SL.Mainnet
+            Byron.NetworkTestnet{}   -> SL.Testnet
 
 {-------------------------------------------------------------------------------
                                     Logging

lib/shelley/test/unit/Cardano/Wallet/Shelley/CompatibilitySpec.hs

@@ -1,17 +1,21 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
+
 {-# OPTIONS_GHC -fno-warn-orphans #-}
+
 module Cardano.Wallet.Shelley.CompatibilitySpec
     ( spec
     ) where
 
 import Prelude
 
 import Cardano.Address.Derivation
-    ( XPrv )
+    ( XPrv, XPub )
 import Cardano.Crypto.Hash.Class
     ( digest )
 import Cardano.Mnemonic
@@ -22,17 +26,23 @@ import Cardano.Mnemonic
     , entropyToMnemonic
     , mkMnemonic
     )
+import Cardano.Wallet.Api.Types
+    ( DecodeAddress (..) )
 import Cardano.Wallet.Primitive.AddressDerivation
     ( Depth (..)
     , NetworkDiscriminant (..)
-    , Passphrase (..)
     , PaymentAddress (..)
-    , getRawKey
+    , WalletKey
     , publicKey
     )
+import Cardano.Wallet.Primitive.AddressDerivation.Byron
+    ( ByronKey (..) )
 import Cardano.Wallet.Primitive.AddressDerivation.Shelley
+    ( ShelleyKey (..) )
 import Cardano.Wallet.Primitive.AddressDiscovery
+    ( isOurs )
 import Cardano.Wallet.Primitive.AddressDiscovery.Sequential
+    ( mkSeqStateFromRootXPrv )
 import Cardano.Wallet.Primitive.Types
     ( Address (..)
     , DecentralizationLevel (..)
@@ -52,8 +62,16 @@ import Cardano.Wallet.Shelley.Compatibility
     )
 import Cardano.Wallet.Unsafe
     ( unsafeFromHex, unsafeMkEntropy )
+import Codec.Binary.Bech32.TH
+    ( humanReadablePart )
 import Control.Monad
     ( forM_ )
+import Data.ByteArray.Encoding
+    ( Base (..), convertToBase )
+import Data.ByteString
+    ( ByteString )
+import Data.ByteString.Base58
+    ( bitcoinAlphabet, encodeBase58 )
 import Data.Function
     ( (&) )
 import Data.Proxy
@@ -72,12 +90,15 @@ import Ouroboros.Network.Block
     ( BlockNo (..), SlotNo (..), Tip (..), getTipPoint )
 import Test.Hspec
     ( Spec, describe, it, shouldBe )
+import Test.Hspec.QuickCheck
+    ( prop )
 import Test.QuickCheck
     ( Arbitrary (..)
     , Gen
-    , InfiniteList (..)
     , checkCoverage
     , choose
+    , conjoin
+    , counterexample
     , cover
     , frequency
     , genericShrink
@@ -87,8 +108,11 @@ import Test.QuickCheck
     , (===)
     )
 
-import qualified Data.ByteArray as BA
+import qualified Cardano.Wallet.Primitive.AddressDerivation.Byron as Byron
+import qualified Cardano.Wallet.Primitive.AddressDerivation.Shelley as Shelley
+import qualified Codec.Binary.Bech32 as Bech32
 import qualified Data.ByteString as BS
+import qualified Data.Text.Encoding as T
 import qualified Shelley.Spec.Ledger.Address as SL
 import qualified Shelley.Spec.Ledger.BaseTypes as SL
 import qualified Shelley.Spec.Ledger.PParams as SL
@@ -102,13 +126,34 @@ spec = do
             toPoint' (fromTip' tip) === (getTipPoint tip)
 
     describe "Shelley Addresses" $ do
-        it "(Mainnet) can be deserialised by shelley ledger spec" $
-            property $ \(k::ShelleyKey 'AddressK XPrv) -> do
-            let Address addr = paymentAddress @'Mainnet $ publicKey k
+        prop "(Mainnet) can be deserialised by shelley ledger spec" $ \k -> do
+            let Address addr = paymentAddress @'Mainnet @ShelleyKey k
             case SL.deserialiseAddr @TPraosStandardCrypto addr of
                 Just _ -> property True
                 Nothing -> property False
 
+        prop "Shelley addresses from base16, bech32 and base58" $ \k -> do
+            let addr@(Address bytes) = paymentAddress @'Mainnet @ShelleyKey k
+            conjoin
+                [ decodeAddress @'Mainnet (base16 bytes) === Right addr
+                    & counterexample (show $ base16 bytes)
+                , decodeAddress @'Mainnet (bech32 bytes) === Right addr
+                    & counterexample (show $ bech32 bytes)
+                , decodeAddress @'Mainnet (base58 bytes) === Right addr
+                    & counterexample (show $ base58 bytes)
+                ]
+
+        prop "Byron addresses from base16, bech32 and base58" $ \k -> do
+            let addr@(Address bytes) = paymentAddress @'Mainnet @ByronKey k
+            conjoin
+                [ decodeAddress @'Mainnet (base16 bytes) === Right addr
+                    & counterexample (show $ base16 bytes)
+                , decodeAddress @'Mainnet (bech32 bytes) === Right addr
+                    & counterexample (show $ bech32 bytes)
+                , decodeAddress @'Mainnet (base58 bytes) === Right addr
+                    & counterexample (show $ base58 bytes)
+                ]
+
         it "can deserialise golden faucet addresses" $ do
             let addr = unsafeFromHex
                     "6194986d1fc893629945058bdb0851478\
@@ -124,7 +169,7 @@ spec = do
                     , "pelican", "find", "coffee", "jar", "april", "permit"
                     , "ticket", "explain", "crime"
                     ]
-            let rootK = unsafeGenerateKeyFromSeed (mw, Nothing) pwd
+            let rootK = Shelley.unsafeGenerateKeyFromSeed (mw, Nothing) pwd
             let s = mkSeqStateFromRootXPrv (rootK, pwd) (toEnum 20)
             let addr = Address $ unsafeFromHex
                     "6194986d1fc893629945058bdb0851478\
@@ -225,19 +270,22 @@ instance Arbitrary SlotId where
 
 instance Arbitrary (ShelleyKey 'AddressK XPrv) where
     shrink _ = []
-    arbitrary = ShelleyKey . getRawKey <$> genRootKeys
+    arbitrary = do
+        mnemonic <- arbitrary
+        return $ Shelley.unsafeGenerateKeyFromSeed mnemonic mempty
 
-genRootKeys :: Gen (ShelleyKey 'RootK XPrv)
-genRootKeys = do
-    mnemonic <- arbitrary
-    e <- genPassphrase @"encryption" (0, 16)
-    return $ generateKeyFromSeed mnemonic e
+instance Arbitrary (ByronKey 'AddressK XPrv) where
+    shrink _ = []
+    arbitrary = do
+        mnemonic <- arbitrary
+        acctIx <- toEnum <$> arbitrary
+        addrIx <- toEnum <$> arbitrary
+        return $ Byron.unsafeGenerateKeyFromSeed (acctIx, addrIx) mnemonic mempty
+
+instance (WalletKey k, Arbitrary (k 'AddressK XPrv)) => Arbitrary (k 'AddressK XPub)
   where
-    genPassphrase :: (Int, Int) -> Gen (Passphrase purpose)
-    genPassphrase range = do
-        n <- choose range
-        InfiniteList bytes _ <- arbitrary
-        return $ Passphrase $ BA.convert $ BS.pack $ take n bytes
+    shrink _ = []
+    arbitrary = publicKey <$> arbitrary
 
 instance Arbitrary SomeMnemonic where
     arbitrary = SomeMnemonic <$> genMnemonic @12
@@ -256,3 +304,18 @@ genMnemonic = do
 
 instance Show XPrv where
     show _ = "<xprv>"
+
+--
+-- Helpers
+--
+--
+
+base16 :: ByteString -> Text
+base16 = T.decodeUtf8 . convertToBase Base16
+
+bech32 :: ByteString -> Text
+bech32 = Bech32.encodeLenient hrp . Bech32.dataPartFromBytes
+  where hrp = [humanReadablePart|addr|]
+
+base58 :: ByteString -> Text
+base58 = T.decodeUtf8 . encodeBase58 bitcoinAlphabet