Skip to content

Commit

Permalink
disable shelley-specific endpoint in Byron server
Browse files Browse the repository at this point in the history 
Until the address format is stabilized on the Haskell side, we will keep this one off
  • Loading branch information
@KtorZ
KtorZ committed Jan 24, 2020
1 parent fa55bab commit 1ae2759
Show file tree
Hide file tree
Showing 3 changed files with 122 additions and 36 deletions.
25 changes: 12 additions & 13 deletions lib/byron/src/Cardano/Wallet/Byron.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -66,15 +66,16 @@ import Cardano.Wallet.Byron.Network
( AddrInfo, newNetworkLayer )
import Cardano.Wallet.Byron.Transaction
( newTransactionLayer )
import Cardano.Wallet.Byron.Transaction.Size
( WorstSizeOf )
import Cardano.Wallet.DB.Sqlite
( DatabasesStartupLog, DefaultFieldValues (..), PersistState )
import Cardano.Wallet.Logging
( filterTraceSeverity, trMessageText )
import Cardano.Wallet.Network
( NetworkLayer (..) )
import Cardano.Wallet.Primitive.AddressDerivation
( DelegationAddress
, Depth (..)
( Depth (..)
, NetworkDiscriminant (..)
, NetworkDiscriminantVal
, PersistPrivateKey
Expand All @@ -85,8 +86,6 @@ import Cardano.Wallet.Primitive.AddressDerivation.Byron
( ByronKey )
import Cardano.Wallet.Primitive.AddressDerivation.Icarus
( IcarusKey )
import Cardano.Wallet.Primitive.AddressDerivation.Shelley
( ShelleyKey )
import Cardano.Wallet.Primitive.AddressDiscovery
( IsOurs )
import Cardano.Wallet.Primitive.AddressDiscovery.Random
Expand All @@ -112,6 +111,8 @@ import Control.Tracer
( Tracer (..), nullTracer, traceWith )
import Data.Function
( (&) )
import Data.Functor
( ($>) )
import Data.Functor.Contravariant
( contramap )
import Data.Proxy
Expand Down Expand Up @@ -145,7 +146,8 @@ serveWallet
, KnownNetwork n
, DecodeAddress n
, EncodeAddress n
, DelegationAddress n ShelleyKey
, WorstSizeOf Address n IcarusKey
, WorstSizeOf Address n ByronKey
, t ~ IO Byron
)
=> Tracers IO
Expand Down Expand Up @@ -175,24 +177,21 @@ serveWallet Tracers{..} sTolerance databaseDir hostPref listen addrInfo beforeMa

serveApp socket = do
let nl = newNetworkLayer nullTracer bp addrInfo (versionData @n)
byronApi <- apiLayer newTransactionLayer nl
icarusApi <- apiLayer newTransactionLayer nl
shelleyApi <- apiLayer newTransactionLayer nl
startServer socket byronApi icarusApi shelleyApi
pure ExitSuccess
byronApi <- apiLayer (newTransactionLayer @n) nl
icarusApi <- apiLayer (newTransactionLayer @n) nl
startServer socket byronApi icarusApi $> ExitSuccess

startServer
:: Socket
-> ApiLayer (RndState 'Mainnet) t ByronKey
-> ApiLayer (SeqState 'Mainnet IcarusKey) t IcarusKey
-> ApiLayer (SeqState n ShelleyKey) t ShelleyKey
-> IO ()
startServer socket byron icarus shelley = do
startServer socket byron icarus = do
sockAddr <- getSocketName socket
let settings = Warp.defaultSettings & setBeforeMainLoop
(beforeMainLoop sockAddr)
let application = Server.serve (Proxy @(ApiV2 n)) $
Server.server byron icarus shelley Server.dummyStakePoolsServer
Server.byronServer byron icarus
Server.start settings apiServerTracer socket application

apiLayer
Expand Down
130 changes: 109 additions & 21 deletions lib/core/src/Cardano/Wallet/Api/Server.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,8 +29,7 @@ module Cardano.Wallet.Api.Server
, start
, serve
, server
, stakePoolsServer
, dummyStakePoolsServer
, byronServer
, newApiLayer
, withListeningSocket
) where
Expand Down Expand Up @@ -430,9 +429,9 @@ server
=> byron
-> icarus
-> shelley
-> Server (StakePools n)
-> StakePoolLayer IO
-> Server (Api n)
server byron icarus shelley stakePools =
server byron icarus shelley spl =
wallets
:<|> addresses
:<|> coinSelections
Expand Down Expand Up @@ -467,6 +466,12 @@ server byron icarus shelley stakePools =
:<|> postTransactionFee shelley
:<|> deleteTransaction shelley

stakePools :: Server (StakePools n)
stakePools = listPools spl
:<|> joinStakePool shelley spl
:<|> quitStakePool shelley
:<|> delegationFee shelley

byronWallets :: Server ByronWallets
byronWallets =
postRandomWallet byron
Expand Down Expand Up @@ -522,24 +527,107 @@ server byron icarus shelley stakePools =
proxy :: Server Proxy_
proxy = postExternalTransaction shelley

stakePoolsServer
:: (DelegationAddress n ShelleyKey)
=> ApiLayer (SeqState n ShelleyKey) t ShelleyKey
-> StakePoolLayer IO
-> Server (StakePools n)
stakePoolsServer shelley spl =
listPools spl
:<|> joinStakePool shelley spl
:<|> quitStakePool shelley
:<|> delegationFee shelley

dummyStakePoolsServer :: Server (StakePools n)
dummyStakePoolsServer =
throwError err501
:<|> (\_ _ _ -> throwError err501)
:<|> (\_ _ _ -> throwError err501)
:<|> (\_ -> throwError err501)

-- | A diminished servant server to serve Byron wallets only.
byronServer
:: forall t n. ()
=> ApiLayer (RndState 'Mainnet) t ByronKey
-> ApiLayer (SeqState 'Mainnet IcarusKey) t IcarusKey
-> Server (Api n)
byronServer byron icarus =
wallets
:<|> addresses
:<|> coinSelections
:<|> transactions
:<|> stakePools
:<|> byronWallets
:<|> byronTransactions
:<|> byronMigrations
:<|> network
:<|> proxy
where
wallets :: Server Wallets
wallets =
(\_ -> throwError err501)
:<|> (\_ -> throwError err501)
:<|> throwError err501
:<|> (\_ -> throwError err501)
:<|> (\_ _ -> throwError err501)
:<|> (\_ _ -> throwError err501)
:<|> (\_ -> throwError err501)
:<|> (\_ _ -> throwError err501)

addresses :: Server (Addresses n)
addresses _ _ = throwError err501

coinSelections :: Server (CoinSelections n)
coinSelections _ _ = throwError err501

transactions :: Server (Transactions n)
transactions =
(\_ _ -> throwError err501)
:<|> (\_ _ _ _ -> throwError err501)
:<|> (\_ _ -> throwError err501)
:<|> (\_ _ -> throwError err501)

stakePools :: Server (StakePools n)
stakePools =
throwError err501
:<|> (\_ _ _ -> throwError err501)
:<|> (\_ _ _ -> throwError err501)
:<|> (\_ -> throwError err501)

byronWallets :: Server ByronWallets
byronWallets =
postRandomWallet byron
:<|> postIcarusWallet icarus
:<|> postTrezorWallet icarus
:<|> postLedgerWallet icarus
:<|> (\wid -> withLegacyLayer wid
(byron , deleteWallet byron wid)
(icarus, deleteWallet icarus wid)
)
:<|> (\wid -> withLegacyLayer wid
(byron , fst <$> getWallet byron mkLegacyWallet wid)
(icarus, fst <$> getWallet icarus mkLegacyWallet wid)
)
:<|> liftA2 (\xs ys -> fmap fst $ sortOn snd $ xs ++ ys)
(listWallets byron mkLegacyWallet)
(listWallets icarus mkLegacyWallet)
:<|> (\wid tip -> withLegacyLayer wid
(byron , forceResyncWallet byron wid tip)
(icarus, forceResyncWallet icarus wid tip)
)

byronTransactions :: Server (ByronTransactions n)
byronTransactions =
(\wid r0 r1 s -> withLegacyLayer wid
(byron , listTransactions byron wid r0 r1 s)
(icarus, listTransactions icarus wid r0 r1 s)
)
:<|> (\wid txid -> withLegacyLayer wid
(byron , deleteTransaction byron wid txid)
(icarus, deleteTransaction icarus wid txid)
)

byronMigrations :: Server (ByronMigrations n)
byronMigrations =
(\wid -> withLegacyLayer wid
(byron , getMigrationInfo byron wid)
(icarus, getMigrationInfo icarus wid)
)
:<|> \_ _ _ -> throwError err501

network :: Server Network
network =
getNetworkInformation genesis nl
:<|> (getNetworkParameters genesis nl)
where
nl = icarus ^. networkLayer @t
genesis = icarus ^. genesisData

proxy :: Server Proxy_
proxy = postExternalTransaction icarus

{-------------------------------------------------------------------------------
Wallet Constructors
Expand Down
3 changes: 1 addition & 2 deletions lib/jormungandr/src/Cardano/Wallet/Jormungandr.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -253,8 +253,7 @@ serveWallet Tracers{..} sTolerance databaseDir hostPref listen backend beforeMai
let settings = Warp.defaultSettings
& setBeforeMainLoop (beforeMainLoop sockAddr nPort bp)
let application = Server.serve (Proxy @(ApiV2 n))
$ Server.server byron icarus shelley
$ Server.stakePoolsServer shelley pools
$ Server.server byron icarus shelley pools
Server.start settings apiServerTracer socket application

apiLayer
Expand Down

0 comments on commit 1ae2759

Please sign in to comment.