@@ -19,24 +19,15 @@ module Cardano.Node.Run
19
19
) where
20
20
21
21
import qualified Cardano.Api as Api
22
- import Prelude
22
+ import Cardano.Prelude hiding (ByteString , STM , atomically , show , take , trace )
23
+ import Data.IP (toSockAddr )
24
+ import Prelude (String , id , show )
23
25
24
- import Control.Concurrent
25
26
import Control.Concurrent.Class.MonadSTM.Strict
26
- import Control.Exception
27
- import Control.Monad
28
- import Control.Monad.IO.Class (liftIO )
29
- import Control.Monad.Trans.Except
30
- import Control.Monad.Trans.Except.Extra
27
+ import Control.Monad.Trans.Except.Extra (left )
31
28
import "contra-tracer" Control.Tracer
32
- import Data.Either
33
- import Data.IP (toSockAddr )
34
- import Data.Map.Strict (Map )
35
29
import qualified Data.Map.Strict as Map
36
- import Data.Maybe
37
- import Data.Monoid
38
- import Data.Proxy
39
- import Data.Text (Text )
30
+ import Data.Text (breakOn , pack , take )
40
31
import qualified Data.Text as Text
41
32
import qualified Data.Text.Encoding as Text
42
33
import Data.Time.Clock (getCurrentTime )
@@ -46,7 +37,6 @@ import Network.HostName (getHostName)
46
37
import Network.Socket (Socket )
47
38
import System.Directory (canonicalizePath , createDirectoryIfMissing , makeAbsolute )
48
39
import System.Environment (lookupEnv )
49
- import System.Exit
50
40
51
41
#ifdef UNIX
52
42
import GHC.Weak (deRefWeak )
@@ -71,23 +61,12 @@ import Cardano.Node.Configuration.NodeAddress
71
61
import Cardano.Node.Configuration.POM (NodeConfiguration (.. ),
72
62
PartialNodeConfiguration (.. ), SomeNetworkP2PMode (.. ),
73
63
defaultPartialNodeConfiguration , makeNodeConfiguration , parseNodeConfigurationFP )
74
- import Cardano.Node.Configuration.Socket (SocketOrSocketInfo (.. ),
75
- gatherConfiguredSockets , getSocketOrSocketInfoAddr )
76
- import qualified Cardano.Node.Configuration.Topology as TopologyNonP2P
77
- import Cardano.Node.Configuration.TopologyP2P
78
- import qualified Cardano.Node.Configuration.TopologyP2P as TopologyP2P
79
- import Cardano.Node.Handlers.Shutdown
80
- import Cardano.Node.Protocol (mkConsensusProtocol )
81
- import Cardano.Node.Protocol.Types
82
- import Cardano.Node.Queries
83
64
import Cardano.Node.Startup
84
- import Cardano.Node.TraceConstraints (TraceConstraints )
85
65
import Cardano.Node.Tracing.API
86
66
import Cardano.Node.Tracing.StateRep (NodeState (NodeKernelOnline ))
87
67
import Cardano.Node.Tracing.Tracers.Startup (getStartupInfo )
88
68
import Cardano.Node.Types
89
69
import Cardano.Tracing.Config (TraceOptions (.. ), TraceSelection (.. ))
90
- import Cardano.Tracing.Tracers
91
70
92
71
import qualified Ouroboros.Consensus.Config as Consensus
93
72
import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (.. ))
@@ -108,6 +87,18 @@ import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPo
108
87
import Ouroboros.Network.Subscription (DnsSubscriptionTarget (.. ),
109
88
IPSubscriptionTarget (.. ))
110
89
90
+ import Cardano.Node.Configuration.Socket (SocketOrSocketInfo (.. ),
91
+ gatherConfiguredSockets , getSocketOrSocketInfoAddr )
92
+ import qualified Cardano.Node.Configuration.Topology as TopologyNonP2P
93
+ import Cardano.Node.Configuration.TopologyP2P
94
+ import qualified Cardano.Node.Configuration.TopologyP2P as TopologyP2P
95
+ import Cardano.Node.Handlers.Shutdown
96
+ import Cardano.Node.Protocol (mkConsensusProtocol )
97
+ import Cardano.Node.Protocol.Types
98
+ import Cardano.Node.Queries
99
+ import Cardano.Node.TraceConstraints (TraceConstraints )
100
+ import Cardano.Tracing.Tracers
101
+
111
102
{- HLINT ignore "Fuse concatMap/map" -}
112
103
{- HLINT ignore "Redundant <$>" -}
113
104
{- HLINT ignore "Use fewer imports" -}
@@ -124,7 +115,7 @@ runNode cmdPc = do
124
115
configYamlPc <- parseNodeConfigurationFP . getLast $ pncConfigFile cmdPc
125
116
126
117
nc <- case makeNodeConfiguration $ defaultPartialNodeConfiguration <> configYamlPc <> cmdPc of
127
- Left err -> error $ " Error in creating the NodeConfiguration: " <> err
118
+ Left err -> panic $ " Error in creating the NodeConfiguration: " <> Text. pack err
128
119
Right nc' -> return nc'
129
120
130
121
putStrLn $ " Node configuration: " <> show nc
@@ -133,7 +124,7 @@ runNode cmdPc = do
133
124
Just vrfFp -> do vrf <- runExceptT $ checkVRFFilePermissions vrfFp
134
125
case vrf of
135
126
Left err ->
136
- putStrLn ( Text. unpack $ renderVRFPrivateKeyFilePermissionError err) >> exitFailure
127
+ putTextLn ( renderVRFPrivateKeyFilePermissionError err) >> exitFailure
137
128
Right () ->
138
129
pure ()
139
130
Nothing -> pure ()
@@ -223,10 +214,10 @@ handleNodeWithTracers cmdPc nc p networkMagic runP = do
223
214
p
224
215
225
216
loggingLayer <- case eLoggingLayer of
226
- Left err -> print err >> exitFailure
217
+ Left err -> putTextLn ( Text. pack $ show err) >> exitFailure
227
218
Right res -> return res
228
219
! trace <- setupTrace loggingLayer
229
- let tracer = contramap Text. pack $ toLogObject trace
220
+ let tracer = contramap pack $ toLogObject trace
230
221
logTracingVerbosity nc tracer
231
222
232
223
-- Legacy logging infrastructure must trace 'nodeStartTime' and 'nodeBasicInfo'.
@@ -291,14 +282,14 @@ setupTrace
291
282
:: LoggingLayer
292
283
-> IO (Trace IO Text )
293
284
setupTrace loggingLayer = do
294
- hn <- maybe hostname (return . Text. pack) =<< lookupEnv " CARDANO_NODE_LOGGING_HOSTNAME"
295
- return . setHostname hn $
296
- llAppendName loggingLayer " node" (llBasicTrace loggingLayer)
285
+ hn <- maybe hostname (pure . pack) =<< lookupEnv " CARDANO_NODE_LOGGING_HOSTNAME"
286
+ return $
287
+ setHostname hn $
288
+ llAppendName loggingLayer " node" (llBasicTrace loggingLayer)
297
289
where
298
- hostname :: IO Text
299
- hostname = do
300
- hn0 <- Text. pack <$> getHostName
301
- return $ Text. take 8 $ fst $ Text. breakOn " ." hn0
290
+ hostname = do
291
+ hn0 <- pack <$> getHostName
292
+ return $ take 8 $ fst $ breakOn " ." hn0
302
293
303
294
{-
304
295
-- TODO: needs to be finished (issue #4362)
@@ -528,11 +519,11 @@ handleSimpleNode runP p2pMode tracers nc onKernel = do
528
519
Signals. Catch $ do
529
520
traceWith (startupTracer tracers) NetworkConfigUpdate
530
521
result <- try $ TopologyP2P. readTopologyFileOrError (startupTracer tracers) nc
531
- case result :: Either IOException NetworkTopology of
532
- Left err ->
522
+ case result of
523
+ Left ( FatalError err) ->
533
524
traceWith (startupTracer tracers)
534
525
$ NetworkConfigUpdateError
535
- $ Text. pack $ " Error reading topology configuration file:" <> show err
526
+ $ pack " Error reading topology configuration file:" <> err
536
527
Right nt -> do
537
528
let (localRoots, publicRoots) = producerAddresses nt
538
529
traceWith (startupTracer tracers)
0 commit comments