Merge pull request #313 from input-output-hk/KtorZ/239/address-format…

…-in-shelley-era

Address Format in Shelley Era (Part 1: abstract over the address encoding)

exe/wallet/Main.hs

@@ -292,7 +292,7 @@ exec manager args
         :<|> _ -- Put Wallet Passphrase
         )
         :<|> createTransaction
-        = client (Proxy @("v2" :> Api))
+        = client (Proxy @("v2" :> Api HttpBridge))
 
     -- | 'runClient' requires a type-application to carry a particular
     -- namespace and adjust error messages accordingly. For instances, when

lib/core/cardano-wallet-core.cabal

@@ -34,7 +34,6 @@ library
   build-depends:
       aeson
     , base
-    , base58-bytestring
     , basement
     , binary
     , bytestring

lib/core/src/Cardano/Wallet/Api.hs

@@ -35,23 +35,23 @@ import Servant.API
     , ReqBody
     )
 
-type Api = Addresses :<|> Wallets :<|> Transactions
+type Api t = Addresses t :<|> Wallets :<|> Transactions t
 
 {-------------------------------------------------------------------------------
                                   Addresses
 
   See also: https://input-output-hk.github.io/cardano-wallet/api/#tag/Addresses
 -------------------------------------------------------------------------------}
 
-type Addresses =
-    ListAddresses
+type Addresses t =
+    ListAddresses t
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/listAddresses
-type ListAddresses = "wallets"
+type ListAddresses t = "wallets"
     :> Capture "walletId" (ApiT WalletId)
     :> "addresses"
     :> QueryParam "state" (ApiT AddressState)
-    :> Get '[JSON] [ApiAddress]
+    :> Get '[JSON] [ApiAddress t]
 
 {-------------------------------------------------------------------------------
                                   Wallets
@@ -105,15 +105,15 @@ type PutWalletPassphrase = "wallets"
   See also: https://input-output-hk.github.io/cardano-wallet/api/#tag/Transactions
 -------------------------------------------------------------------------------}
 
-type Transactions =
-    CreateTransaction
+type Transactions t =
+    CreateTransaction t
 
 -- | https://input-output-hk.github.io/cardano-wallet/api/#operation/postTransaction
-type CreateTransaction = "wallets"
+type CreateTransaction t = "wallets"
     :> Capture "walletId" (ApiT WalletId)
     :> "transactions"
-    :> ReqBody '[JSON] PostTransactionData
-    :> PostAccepted '[JSON] ApiTransaction
+    :> ReqBody '[JSON] (PostTransactionData t)
+    :> PostAccepted '[JSON] (ApiTransaction t)
 
 {-------------------------------------------------------------------------------
                                    Internals

lib/core/src/Cardano/Wallet/Api/Server.hs

@@ -62,6 +62,8 @@ import Cardano.Wallet.Primitive.Model
 import Cardano.Wallet.Primitive.Types
     ( AddressState
     , Coin (..)
+    , DecodeAddress (..)
+    , EncodeAddress (..)
     , TxId (..)
     , TxOut (..)
     , WalletId (..)
@@ -124,7 +126,7 @@ import qualified Network.Wai.Handler.Warp as Warp
 
 -- | Start the application server
 start
-    :: (TxId t, KeyToAddress t)
+    :: forall t. (TxId t, KeyToAddress t, EncodeAddress t, DecodeAddress t)
     => Warp.Settings
     -> WalletLayer (SeqState t) t
     -> IO ()
@@ -133,11 +135,11 @@ start settings wl = Warp.runSettings settings
     application
   where
     -- | A Servant server for our wallet API
-    server :: Server Api
+    server :: Server (Api t)
     server = addresses wl :<|> wallets wl :<|> transactions wl
 
     application :: Application
-    application = serve (Proxy @("v2" :> Api)) server
+    application = serve (Proxy @("v2" :> Api t)) server
 
 {-------------------------------------------------------------------------------
                                     Wallets
@@ -240,33 +242,34 @@ putWalletPassphrase w (ApiT wid) body = do
                                     Addresses
 -------------------------------------------------------------------------------}
 
-addresses :: WalletLayer (SeqState t) t -> Server Addresses
+addresses :: WalletLayer (SeqState t) t -> Server (Addresses t)
 addresses = listAddresses
 
 listAddresses
-    :: WalletLayer (SeqState t) t
+    :: forall t. ()
+    => WalletLayer (SeqState t) t
     -> ApiT WalletId
     -> Maybe (ApiT AddressState)
-    -> Handler [ApiAddress]
+    -> Handler [ApiAddress t]
 listAddresses w (ApiT wid) _ = do
     addrs <- liftHandler $ W.listAddresses w wid
     return $ coerceAddress <$> addrs
   where
-    coerceAddress (a, s) = ApiAddress (ApiT a) (ApiT s)
+    coerceAddress (a, s) = ApiAddress (ApiT a, Proxy @t) (ApiT s)
 
 {-------------------------------------------------------------------------------
                                     Transactions
 -------------------------------------------------------------------------------}
 
-transactions :: TxId t => WalletLayer (SeqState t) t -> Server Transactions
+transactions :: TxId t => WalletLayer (SeqState t) t -> Server (Transactions t)
 transactions = createTransaction
 
 createTransaction
     :: forall t. (TxId t)
     => WalletLayer (SeqState t) t
     -> ApiT WalletId
-    -> PostTransactionData
-    -> Handler ApiTransaction
+    -> PostTransactionData t
+    -> Handler (ApiTransaction t)
 createTransaction w (ApiT wid) body = do
     -- FIXME Compute the options based on the transaction's size / inputs
     let opts = CoinSelectionOptions { maximumNumberOfInputs = 10 }
@@ -286,12 +289,12 @@ createTransaction w (ApiT wid) body = do
         , status = ApiT (meta ^. #status)
         }
   where
-    coerceCoin :: AddressAmount -> TxOut
-    coerceCoin (AddressAmount (ApiT addr) (Quantity c)) =
+    coerceCoin :: AddressAmount t -> TxOut
+    coerceCoin (AddressAmount (ApiT addr, _) (Quantity c)) =
         TxOut addr (Coin $ fromIntegral c)
-    coerceTxOut :: TxOut -> AddressAmount
+    coerceTxOut :: TxOut -> AddressAmount t
     coerceTxOut (TxOut addr (Coin c)) =
-        AddressAmount (ApiT addr) (Quantity $ fromIntegral c)
+        AddressAmount (ApiT addr, Proxy @t) (Quantity $ fromIntegral c)
 
 {-------------------------------------------------------------------------------
                                 Error Handling

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

@@ -9,6 +9,7 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE TypeOperators #-}
@@ -60,7 +61,9 @@ import Cardano.Wallet.Primitive.Types
     ( Address (..)
     , AddressState (..)
     , Coin (..)
+    , DecodeAddress (..)
     , Direction (..)
+    , EncodeAddress (..)
     , Hash (..)
     , PoolId (..)
     , ShowFmt (..)
@@ -94,6 +97,8 @@ import Data.Bifunctor
     ( bimap )
 import Data.List.NonEmpty
     ( NonEmpty (..) )
+import Data.Proxy
+    ( Proxy (..) )
 import Data.Quantity
     ( Quantity (..) )
 import Data.Text
@@ -121,8 +126,8 @@ import qualified Data.Text as T
                                   API Types
 -------------------------------------------------------------------------------}
 
-data ApiAddress = ApiAddress
-    { id :: !(ApiT Address)
+data ApiAddress t = ApiAddress
+    { id :: !(ApiT Address, Proxy t)
     , state :: !(ApiT AddressState)
     } deriving (Eq, Generic, Show)
 
@@ -153,24 +158,24 @@ data WalletPutPassphraseData = WalletPutPassphraseData
     , newPassphrase :: !(ApiT (Passphrase "encryption-new"))
     } deriving (Eq, Generic, Show)
 
-data PostTransactionData = PostTransactionData
-    { payments :: !(NonEmpty AddressAmount)
+data PostTransactionData t = PostTransactionData
+    { payments :: !(NonEmpty (AddressAmount t))
     , passphrase :: !(ApiT (Passphrase "encryption"))
     } deriving (Eq, Generic, Show)
 
-data ApiTransaction = ApiTransaction
+data ApiTransaction t = ApiTransaction
     { id :: !(ApiT (Hash "Tx"))
     , amount :: !(Quantity "lovelace" Natural)
     , insertedAt :: !(Maybe ApiBlockData)
     , depth :: !(Quantity "block" Natural)
     , direction :: !(ApiT Direction)
-    , inputs :: !(NonEmpty AddressAmount)
-    , outputs :: !(NonEmpty AddressAmount)
+    , inputs :: !(NonEmpty (AddressAmount t))
+    , outputs :: !(NonEmpty (AddressAmount t))
     , status :: !(ApiT TxStatus)
     } deriving (Eq, Generic, Show)
 
-data AddressAmount = AddressAmount
-    { address :: !(ApiT Address)
+data AddressAmount t = AddressAmount
+    { address :: !(ApiT Address, Proxy t)
     , amount :: !(Quantity "lovelace" Natural)
     } deriving (Eq, Generic, Show)
 
@@ -244,21 +249,28 @@ getApiMnemonicT (ApiMnemonicT (pw, _)) = pw
                                JSON Instances
 -------------------------------------------------------------------------------}
 
-instance FromJSON ApiAddress where
+instance DecodeAddress t => FromJSON (ApiAddress t) where
     parseJSON = genericParseJSON defaultRecordTypeOptions
-instance ToJSON ApiAddress where
+instance EncodeAddress t => ToJSON (ApiAddress t) where
     toJSON = genericToJSON defaultRecordTypeOptions
 
+instance {-# OVERLAPS #-} DecodeAddress t => FromJSON (ApiT Address, Proxy t)
+  where
+    parseJSON x = do
+        let proxy = Proxy @t
+        addr <- parseJSON x >>= eitherToParser
+            . bimap ShowFmt ApiT
+            . decodeAddress proxy
+        return (addr, proxy)
+instance {-# OVERLAPS #-} EncodeAddress t => ToJSON (ApiT Address, Proxy t)
+  where
+    toJSON (addr, proxy) = toJSON . encodeAddress proxy . getApiT $ addr
+
 instance FromJSON (ApiT AddressState) where
     parseJSON = fmap ApiT . genericParseJSON defaultSumTypeOptions
 instance ToJSON (ApiT AddressState) where
     toJSON = genericToJSON defaultSumTypeOptions . getApiT
 
-instance FromJSON (ApiT Address) where
-    parseJSON = parseJSON >=> eitherToParser . bimap ShowFmt ApiT . fromText
-instance ToJSON (ApiT Address) where
-    toJSON = toJSON . toText . getApiT
-
 instance FromJSON ApiWallet where
     parseJSON = genericParseJSON defaultRecordTypeOptions
 instance ToJSON ApiWallet where
@@ -336,9 +348,9 @@ instance FromJSON (ApiT PoolId) where
 instance ToJSON (ApiT PoolId) where
     toJSON = toJSON . getPoolId . getApiT
 
-instance FromJSON PostTransactionData where
+instance DecodeAddress t => FromJSON (PostTransactionData t) where
     parseJSON = genericParseJSON defaultRecordTypeOptions
-instance ToJSON PostTransactionData where
+instance EncodeAddress t => ToJSON (PostTransactionData t) where
     toJSON = genericToJSON defaultRecordTypeOptions
 
 instance FromJSON (ApiT SlotId) where
@@ -351,7 +363,7 @@ instance FromJSON ApiBlockData where
 instance ToJSON ApiBlockData where
     toJSON = genericToJSON defaultRecordTypeOptions
 
-instance FromJSON AddressAmount where
+instance DecodeAddress t => FromJSON (AddressAmount t) where
     parseJSON bytes = do
         v@(AddressAmount _ (Quantity c)) <-
             genericParseJSON defaultRecordTypeOptions bytes
@@ -361,12 +373,12 @@ instance FromJSON AddressAmount where
                 "invalid coin value: value has to be lower than or equal to "
                 <> show (getCoin maxBound) <> " lovelace."
 
-instance ToJSON AddressAmount where
+instance EncodeAddress t => ToJSON (AddressAmount t) where
     toJSON = genericToJSON defaultRecordTypeOptions
 
-instance FromJSON ApiTransaction where
+instance DecodeAddress t => FromJSON (ApiTransaction t) where
     parseJSON = genericParseJSON defaultRecordTypeOptions
-instance ToJSON ApiTransaction where
+instance EncodeAddress t => ToJSON (ApiTransaction t) where
     toJSON = genericToJSON defaultRecordTypeOptions
 
 instance FromJSON (ApiT (Hash "Tx")) where
@@ -420,19 +432,21 @@ walletStateOptions = taggedSumTypeOptions $ TaggedObjectOptions
                              FromText/ToText instances
 -------------------------------------------------------------------------------}
 
-instance FromText AddressAmount where
+instance DecodeAddress t => FromText (AddressAmount t) where
     fromText text = do
         let err = Left . TextDecodingError $ "Parse error. Expecting format \
             \\"<amount>@<address>\" but got " <> show text
         case split (=='@') text of
             [] -> err
             [_] -> err
-            [l, r] -> AddressAmount . ApiT <$> fromText r <*> fromText l
+            [l, r] -> AddressAmount
+                <$> fmap ((,Proxy @t) . ApiT) (decodeAddress (Proxy @t) r)
+                <*> fromText l
             _ -> err
 
-instance ToText AddressAmount where
-    toText (AddressAmount (ApiT addr) coins) =
-        toText coins <> "@" <> toText addr
+instance EncodeAddress t => ToText (AddressAmount t) where
+    toText (AddressAmount (ApiT addr, proxy) coins) =
+        toText coins <> "@" <> encodeAddress proxy addr
 
 {-------------------------------------------------------------------------------
                              HTTPApiData instances