Skip to content

Commit 5249f5d

Browse files
committed
Introduce BlockfrostSource
1 parent a669ebc commit 5249f5d

File tree

6 files changed

+131
-50
lines changed

6 files changed

+131
-50
lines changed

lib/shelley/cardano-wallet.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -103,6 +103,7 @@ library
103103
Cardano.Wallet.Byron.Compatibility
104104
Cardano.Wallet.Shelley
105105
Cardano.Wallet.Shelley.Api.Server
106+
Cardano.Wallet.Shelley.BlockchainSource
106107
Cardano.Wallet.Shelley.Compatibility
107108
Cardano.Wallet.Shelley.Compatibility.Ledger
108109
Cardano.Wallet.Shelley.Network

lib/shelley/exe/cardano-wallet.hs

Lines changed: 43 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -88,6 +88,8 @@ import Cardano.Wallet.Primitive.SyncProgress
8888
( SyncTolerance )
8989
import Cardano.Wallet.Primitive.Types
9090
( PoolMetadataSource (..), Settings (..), TokenMetadataServer (..) )
91+
import Cardano.Wallet.Primitive.Types.BlockchainSource
92+
( BlockchainSource (..) )
9193
import Cardano.Wallet.Shelley
9294
( TracerSeverities
9395
, Tracers
@@ -98,7 +100,7 @@ import Cardano.Wallet.Shelley
98100
, tracerLabels
99101
)
100102
import Cardano.Wallet.Shelley.Launch
101-
( Mode
103+
( Mode (Light, Normal)
102104
, NetworkConfiguration (..)
103105
, modeFlag
104106
, networkConfigurationOption
@@ -150,6 +152,7 @@ import qualified Cardano.BM.Backend.EKGView as EKG
150152
import qualified Cardano.Wallet.Version as V
151153
import qualified Data.Text as T
152154
import qualified System.Info as I
155+
import qualified Cardano.Wallet.Shelley.Launch.Blockfrost as Blockfrost
153156

154157
{-------------------------------------------------------------------------------
155158
Main entry point
@@ -192,10 +195,9 @@ data ServeArgs = ServeArgs
192195
, _logging :: LoggingOptions TracerSeverities
193196
} deriving (Show)
194197

195-
cmdServe
196-
:: Mod CommandFields (IO ())
197-
cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
198-
<> progDesc "Serve API that listens for commands/actions."
198+
cmdServe :: Mod CommandFields (IO ())
199+
cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $
200+
progDesc "Serve API that listens for commands/actions."
199201
where
200202
helper' = helperTracing tracerDescriptions
201203

@@ -212,11 +214,11 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
212214
<*> optional poolMetadataSourceOption
213215
<*> optional tokenMetadataSourceOption
214216
<*> loggingOptions tracerSeveritiesOption
215-
exec
216-
:: ServeArgs -> IO ()
217+
218+
exec :: ServeArgs -> IO ()
217219
exec args@(ServeArgs
218220
host
219-
_mode
221+
mode
220222
listen
221223
tlsConfig
222224
conn
@@ -226,34 +228,41 @@ cmdServe = command "serve" $ info (helper <*> helper' <*> cmd) $ mempty
226228
enableShutdownHandler
227229
poolMetadataFetching
228230
tokenMetadataServerURI
229-
logOpt) = do
230-
withTracers logOpt $ \tr tracers -> do
231-
withShutdownHandlerMaybe tr enableShutdownHandler $ do
232-
logDebug tr $ MsgServeArgs args
231+
logOpt) = withTracers logOpt $ \tr tracers -> do
232+
withShutdownHandlerMaybe tr enableShutdownHandler $ do
233+
logDebug tr $ MsgServeArgs args
234+
235+
(discriminant, netParams, vData, block0)
236+
<- runExceptT (parseGenesisData networkConfig) >>= \case
237+
Right x -> pure x
238+
Left err -> do
239+
logError tr (MsgFailedToParseGenesis $ T.pack err)
240+
exitWith $ ExitFailure 33
241+
whenJust databaseDir $
242+
setupDirectory (logInfo tr . MsgSetupDatabases)
233243

234-
(discriminant, gp, vData, block0)
235-
<- runExceptT (parseGenesisData networkConfig) >>= \case
236-
Right x -> pure x
237-
Left err -> do
238-
logError tr (MsgFailedToParseGenesis $ T.pack err)
239-
exitWith $ ExitFailure 33
244+
blockchainSource <- case mode of
245+
Normal ->
246+
pure $ NodeSource conn netParams vData
247+
Light (Just token) ->
248+
BlockfrostSource <$> Blockfrost.readToken token
249+
Light Nothing ->
250+
exitWith $ ExitFailure 34 -- TODO: where are these codes catalogued?
240251

241-
whenJust databaseDir $ setupDirectory (logInfo tr . MsgSetupDatabases)
242-
exitWith =<< serveWallet
243-
discriminant
244-
tracers
245-
sTolerance
246-
databaseDir
247-
Nothing
248-
host
249-
listen
250-
tlsConfig
251-
(fmap Settings poolMetadataFetching)
252-
tokenMetadataServerURI
253-
conn
254-
block0
255-
(gp, vData)
256-
(beforeMainLoop tr)
252+
exitWith =<< serveWallet
253+
blockchainSource
254+
discriminant
255+
tracers
256+
sTolerance
257+
databaseDir
258+
Nothing
259+
host
260+
listen
261+
tlsConfig
262+
(Settings <$> poolMetadataFetching)
263+
tokenMetadataServerURI
264+
block0
265+
(beforeMainLoop tr)
257266

258267
whenJust m fn = case m of
259268
Nothing -> pure ()

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

Lines changed: 55 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -130,6 +130,8 @@ import Cardano.Wallet.Registry
130130
( HasWorkerCtx (..), traceAfterThread )
131131
import Cardano.Wallet.Shelley.Api.Server
132132
( server )
133+
import Cardano.Wallet.Shelley.BlockchainSource
134+
( BlockchainSource (..) )
133135
import Cardano.Wallet.Shelley.Compatibility
134136
( CardanoBlock, HasNetworkId (..), StandardCrypto, fromCardanoBlock )
135137
import Cardano.Wallet.Shelley.Network
@@ -190,6 +192,7 @@ import UnliftIO.MVar
190192
import UnliftIO.STM
191193
( newTVarIO )
192194

195+
import qualified Blockfrost.Client as Blockfrost
193196
import qualified Cardano.Pool.DB.Sqlite as Pool
194197
import qualified Cardano.Wallet.Api.Server as Server
195198
import qualified Cardano.Wallet.DB.Sqlite as Sqlite
@@ -222,7 +225,9 @@ deriving instance Show SomeNetworkDiscriminant
222225
-- which was passed from the CLI and environment and starts all components of
223226
-- the wallet.
224227
serveWallet
225-
:: SomeNetworkDiscriminant
228+
:: BlockchainSource
229+
-- ^ Source of the blockchain data
230+
-> SomeNetworkDiscriminant
226231
-- ^ Proxy for the network discriminant
227232
-> Tracers IO
228233
-- ^ Logging config.
@@ -241,18 +246,43 @@ serveWallet
241246
-> Maybe Settings
242247
-- ^ Settings to be set at application start, will be written into DB.
243248
-> Maybe TokenMetadataServer
244-
-> CardanoNodeConn
245-
-- ^ Socket for communicating with the node
246249
-> Block
247250
-- ^ The genesis block, or some starting point.
248-
-> ( NetworkParameters, NodeToClientVersionData)
249-
-- ^ Network parameters needed to connect to the underlying network.
250-
--
251251
-- See also: 'Cardano.Wallet.Shelley.Compatibility#KnownNetwork'.
252252
-> (URI -> IO ())
253253
-- ^ Callback to run before the main loop
254254
-> IO ExitCode
255-
serveWallet
255+
serveWallet = \case
256+
NodeSource nodeConn netParams nodeToClientVersionData ->
257+
serveWalletNode nodeConn netParams nodeToClientVersionData
258+
BlockfrostSource blockfrostProject ->
259+
serveWalletLight blockfrostProject
260+
261+
-- | Starts wallet with cardano node as a blockchain data source
262+
serveWalletNode ::
263+
CardanoNodeConn
264+
-- ^ Socket for communicating with the node
265+
-> NetworkParameters
266+
-- ^ Records the complete set of parameters
267+
-- currently in use by the network that are relevant to the wallet.
268+
-> NodeToClientVersionData
269+
-> SomeNetworkDiscriminant
270+
-> Tracers IO
271+
-> SyncTolerance
272+
-> Maybe FilePath
273+
-> Maybe (Pool.DBDecorator IO)
274+
-> HostPreference
275+
-> Listen
276+
-> Maybe TlsConfiguration
277+
-> Maybe Settings
278+
-> Maybe TokenMetadataServer
279+
-> Block
280+
-> (URI -> IO ())
281+
-> IO ExitCode
282+
serveWalletNode
283+
conn
284+
np
285+
vData
256286
(SomeNetworkDiscriminant proxy)
257287
Tracers{..}
258288
sTolerance
@@ -263,9 +293,7 @@ serveWallet
263293
tlsConfig
264294
settings
265295
tokenMetaUri
266-
conn
267296
block0
268-
(np, vData)
269297
beforeMainLoop = do
270298
let ntwrk = networkDiscriminantValFromProxy proxy
271299
traceWith applicationTracer $ MsgStarting conn
@@ -288,8 +316,7 @@ serveWallet
288316
(Server.manageRewardBalance proxy)
289317

290318
let txLayerUdefined = error "TO-DO in ADP-686"
291-
multisigApi <- apiLayer txLayerUdefined nl
292-
Server.idleWorker
319+
multisigApi <- apiLayer txLayerUdefined nl Server.idleWorker
293320

294321
withPoolsMonitoring databaseDir np nl $ \spl -> do
295322
startServer
@@ -441,6 +468,23 @@ serveWallet
441468
traceWith applicationTracer $ MsgServerStartupError err
442469
pure $ ExitFailure $ exitCodeApiServer err
443470

471+
serveWalletLight ::
472+
Blockfrost.Project
473+
-> SomeNetworkDiscriminant
474+
-> Tracers IO
475+
-> SyncTolerance
476+
-> Maybe FilePath
477+
-> Maybe (Pool.DBDecorator IO)
478+
-> HostPreference
479+
-> Listen
480+
-> Maybe TlsConfiguration
481+
-> Maybe Settings
482+
-> Maybe TokenMetadataServer
483+
-> Block
484+
-> (URI -> IO ())
485+
-> IO ExitCode
486+
serveWalletLight = error "not implemented"
487+
444488
-- | Failure status codes for HTTP API server errors.
445489
exitCodeApiServer :: ListenError -> Int
446490
exitCodeApiServer = \case
Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
-- |
2+
-- Copyright: © 2018-2020 IOHK
3+
-- License: Apache-2.0
4+
--
5+
-- Source of the blockchain data for the wallet
6+
--
7+
module Cardano.Wallet.Shelley.BlockchainSource
8+
( BlockchainSource(..)
9+
) where
10+
11+
import Cardano.Launcher.Node
12+
( CardanoNodeConn )
13+
import Cardano.Wallet.Primitive.Types
14+
( NetworkParameters )
15+
import Cardano.Wallet.Shelley.Compatibility
16+
( NodeToClientVersionData )
17+
18+
import qualified Blockfrost.Client as Blockfrost
19+
20+
data BlockchainSource
21+
= NodeSource
22+
CardanoNodeConn
23+
-- ^ Socket for communicating with the node
24+
NetworkParameters
25+
-- ^ Records the complete set of parameters
26+
-- currently in use by the network that are relevant to the wallet.
27+
NodeToClientVersionData
28+
| BlockfrostSource Blockfrost.Project
29+
-- ^ Blockfrost token when working in the light mode

lib/shelley/src/Cardano/Wallet/Shelley/Launch/Blockfrost.hs

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,6 @@
33

44
module Cardano.Wallet.Shelley.Launch.Blockfrost
55
( TokenFile
6-
, Token
76
, readToken
87
, tokenFileOption
98
) where
@@ -20,8 +19,6 @@ import Options.Applicative
2019
newtype TokenFile = TokenFile FilePath
2120
deriving newtype (Eq, Show, Read)
2221

23-
newtype Token = Token Project
24-
2522
-- | --blockfrost-token-file FILE
2623
tokenFileOption :: Parser TokenFile
2724
tokenFileOption = option auto $ mconcat
@@ -33,5 +30,5 @@ tokenFileOption = option auto $ mconcat
3330
]
3431
]
3532

36-
readToken :: TokenFile -> IO Token
37-
readToken (TokenFile fp) = Token <$> projectFromFile fp
33+
readToken :: TokenFile -> IO Project
34+
readToken (TokenFile fp) = projectFromFile fp

nix/materialized/stack-nix/cardano-wallet.nix

Lines changed: 1 addition & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

0 commit comments

Comments
 (0)