Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Merged
merged 4 commits into from
May 27, 2019
Merged

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

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
cb08b03
define new 'EncodeAddress' & 'DecodeAddress' abstractions
KtorZ May 23, 2019
e5eb091
carry backend type in API type, review JSON instances as necessary
KtorZ May 23, 2019
42eb63f
adjust tests to use backend target for Api types carrying an address
KtorZ May 23, 2019
e6d5c42
update .cabal files dependencies and modules
KtorZ May 27, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion exe/wallet/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 0 additions & 1 deletion lib/core/cardano-wallet-core.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -34,7 +34,6 @@ library
build-depends:
aeson
, base
, base58-bytestring
, basement
, binary
, bytestring
Expand Down
20 changes: 10 additions & 10 deletions lib/core/src/Cardano/Wallet/Api.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Does this type constraint mean that the wallet API won't be able to make payments to addresses which are of an encoding different to t?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That is a valid point and the answer is: yes. This means we'll only parse address according to the encoding supported by t (note that, this is already implicitly the case at the moment. If one uses something else than Base58, the API returns an error expecting an address in Base58).

Whether we should allow different encoding for addresses is up to discussion I believe, although there's no clear use-case for it at the moment I believe. That's a very valid question to ask ourselves (and product) however.

:> Capture "walletId" (ApiT WalletId)
:> "transactions"
:> ReqBody '[JSON] PostTransactionData
:> PostAccepted '[JSON] ApiTransaction
:> ReqBody '[JSON] (PostTransactionData t)
:> PostAccepted '[JSON] (ApiTransaction t)

{-------------------------------------------------------------------------------
Internals
Expand Down
31 changes: 17 additions & 14 deletions lib/core/src/Cardano/Wallet/Api/Server.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -62,6 +62,8 @@ import Cardano.Wallet.Primitive.Model
import Cardano.Wallet.Primitive.Types
( AddressState
, Coin (..)
, DecodeAddress (..)
, EncodeAddress (..)
, TxId (..)
, TxOut (..)
, WalletId (..)
Expand Down Expand Up @@ -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 ()
Expand All @@ -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
Expand Down Expand Up @@ -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 }
Expand All @@ -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
Expand Down
68 changes: 41 additions & 27 deletions lib/core/src/Cardano/Wallet/Api/Types.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -9,6 +9,7 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
Expand Down Expand Up @@ -60,7 +61,9 @@ import Cardano.Wallet.Primitive.Types
( Address (..)
, AddressState (..)
, Coin (..)
, DecodeAddress (..)
, Direction (..)
, EncodeAddress (..)
, Hash (..)
, PoolId (..)
, ShowFmt (..)
Expand Down Expand Up @@ -94,6 +97,8 @@ import Data.Bifunctor
( bimap )
import Data.List.NonEmpty
( NonEmpty (..) )
import Data.Proxy
( Proxy (..) )
import Data.Quantity
( Quantity (..) )
import Data.Text
Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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)

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Expand Down
Loading