Skip to content

Commit e014054

Browse files
committed
Revert "Merge pull request #4855 from input-output-hk/jordan/remove-cli-node-dependency"
This reverts commit 75dfd53, reversing changes made to c8862fe.
1 parent 75dfd53 commit e014054

File tree

3 files changed

+34
-121
lines changed

3 files changed

+34
-121
lines changed

cardano-cli/cardano-cli.cabal

+1-3
Original file line numberDiff line numberDiff line change
@@ -163,8 +163,6 @@ executable cardano-cli
163163

164164
test-suite cardano-cli-test
165165
import: project-config
166-
, maybe-Win32
167-
, maybe-unix
168166

169167
hs-source-dirs: test
170168
main-is: cardano-cli-test.hs
@@ -176,6 +174,7 @@ test-suite cardano-cli-test
176174
, cardano-api
177175
, cardano-api:gen
178176
, cardano-cli
177+
, cardano-node
179178
, cardano-prelude
180179
, cardano-slotting ^>= 0.1
181180
, containers
@@ -188,7 +187,6 @@ test-suite cardano-cli-test
188187
, text
189188
, time
190189
, transformers
191-
, transformers-except
192190
, yaml
193191

194192
other-modules: Test.Config.Mainnet

cardano-cli/test/Test/Cli/FilePermissions.hs

+2-78
Original file line numberDiff line numberDiff line change
@@ -1,31 +1,14 @@
1-
{-# LANGUAGE CPP #-}
21
{-# LANGUAGE OverloadedStrings #-}
32
{-# LANGUAGE TemplateHaskell #-}
43

5-
#if !defined(mingw32_HOST_OS)
6-
#define UNIX
7-
#endif
8-
94
module Test.Cli.FilePermissions
105
( tests
116
) where
127

13-
import Prelude
14-
15-
import Control.Monad
16-
import Control.Monad.IO.Class
17-
import Control.Monad.Trans.Except
18-
import Control.Monad.Trans.Except.Extra
19-
import Data.Text (Text)
20-
import qualified Data.Text as Text
8+
import Cardano.Prelude
219

22-
#ifdef UNIX
23-
import System.Posix.Files
24-
import System.Posix.Types (FileMode)
25-
#else
26-
import System.Win32.File
27-
#endif
2810

11+
import Cardano.Node.Run (checkVRFFilePermissions)
2912
import Hedgehog (Property, discover, success)
3013
import qualified Hedgehog
3114
import qualified Hedgehog.Extras.Test.Base as H
@@ -57,65 +40,6 @@ prop_createVRFSigningKeyFilePermissions =
5740
\file with the wrong permissions: " <> show err
5841
Right () -> success
5942

60-
data VRFPrivateKeyFilePermissionError
61-
= OtherPermissionsExist !FilePath
62-
| GroupPermissionsExist !FilePath
63-
| GenericPermissionsExist !FilePath
64-
deriving Show
65-
66-
renderVRFPrivateKeyFilePermissionError :: VRFPrivateKeyFilePermissionError -> Text
67-
renderVRFPrivateKeyFilePermissionError err =
68-
case err of
69-
OtherPermissionsExist fp ->
70-
"VRF private key file at: " <> Text.pack fp
71-
<> " has \"other\" file permissions. Please remove all \"other\" file permissions."
72-
73-
GroupPermissionsExist fp ->
74-
"VRF private key file at: " <> Text.pack fp
75-
<> "has \"group\" file permissions. Please remove all \"group\" file permissions."
76-
GenericPermissionsExist fp ->
77-
"VRF private key file at: " <> Text.pack fp
78-
<> "has \"generic\" file permissions. Please remove all \"generic\" file permissions."
79-
80-
81-
-- | Make sure the VRF private key file is readable only
82-
-- by the current process owner the node is running under.
83-
checkVRFFilePermissions :: FilePath -> ExceptT VRFPrivateKeyFilePermissionError IO ()
84-
#ifdef UNIX
85-
checkVRFFilePermissions vrfPrivKey = do
86-
fs <- liftIO $ getFileStatus vrfPrivKey
87-
let fm = fileMode fs
88-
-- Check the the VRF private key file does not give read/write/exec permissions to others.
89-
when (hasOtherPermissions fm)
90-
(left $ OtherPermissionsExist vrfPrivKey)
91-
-- Check the the VRF private key file does not give read/write/exec permissions to any group.
92-
when (hasGroupPermissions fm)
93-
(left $ GroupPermissionsExist vrfPrivKey)
94-
where
95-
hasPermission :: FileMode -> FileMode -> Bool
96-
hasPermission fModeA fModeB = fModeA `intersectFileModes` fModeB /= nullFileMode
97-
98-
hasOtherPermissions :: FileMode -> Bool
99-
hasOtherPermissions fm' = fm' `hasPermission` otherModes
100-
101-
hasGroupPermissions :: FileMode -> Bool
102-
hasGroupPermissions fm' = fm' `hasPermission` groupModes
103-
#else
104-
checkVRFFilePermissions vrfPrivKey = do
105-
attribs <- liftIO $ getFileAttributes vrfPrivKey
106-
-- https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
107-
-- https://docs.microsoft.com/en-us/windows/win32/fileio/file-access-rights-constants
108-
-- https://docs.microsoft.com/en-us/windows/win32/secauthz/standard-access-rights
109-
-- https://docs.microsoft.com/en-us/windows/win32/secauthz/generic-access-rights
110-
-- https://docs.microsoft.com/en-us/windows/win32/secauthz/access-mask
111-
when (attribs `hasPermission` genericPermissions)
112-
(left $ GenericPermissionsExist vrfPrivKey)
113-
where
114-
genericPermissions = gENERIC_ALL .|. gENERIC_READ .|. gENERIC_WRITE .|. gENERIC_EXECUTE
115-
hasPermission fModeA fModeB = fModeA .&. fModeB /= gENERIC_NONE
116-
#endif
117-
118-
11943
-- -----------------------------------------------------------------------------
12044

12145
tests :: IO Bool

cardano-node/src/Cardano/Node/Run.hs

+31-40
Original file line numberDiff line numberDiff line change
@@ -19,24 +19,15 @@ module Cardano.Node.Run
1919
) where
2020

2121
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)
2325

24-
import Control.Concurrent
2526
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)
3128
import "contra-tracer" Control.Tracer
32-
import Data.Either
33-
import Data.IP (toSockAddr)
34-
import Data.Map.Strict (Map)
3529
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)
4031
import qualified Data.Text as Text
4132
import qualified Data.Text.Encoding as Text
4233
import Data.Time.Clock (getCurrentTime)
@@ -46,7 +37,6 @@ import Network.HostName (getHostName)
4637
import Network.Socket (Socket)
4738
import System.Directory (canonicalizePath, createDirectoryIfMissing, makeAbsolute)
4839
import System.Environment (lookupEnv)
49-
import System.Exit
5040

5141
#ifdef UNIX
5242
import GHC.Weak (deRefWeak)
@@ -71,23 +61,12 @@ import Cardano.Node.Configuration.NodeAddress
7161
import Cardano.Node.Configuration.POM (NodeConfiguration (..),
7262
PartialNodeConfiguration (..), SomeNetworkP2PMode (..),
7363
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
8364
import Cardano.Node.Startup
84-
import Cardano.Node.TraceConstraints (TraceConstraints)
8565
import Cardano.Node.Tracing.API
8666
import Cardano.Node.Tracing.StateRep (NodeState (NodeKernelOnline))
8767
import Cardano.Node.Tracing.Tracers.Startup (getStartupInfo)
8868
import Cardano.Node.Types
8969
import Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..))
90-
import Cardano.Tracing.Tracers
9170

9271
import qualified Ouroboros.Consensus.Config as Consensus
9372
import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..))
@@ -108,6 +87,18 @@ import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPo
10887
import Ouroboros.Network.Subscription (DnsSubscriptionTarget (..),
10988
IPSubscriptionTarget (..))
11089

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+
111102
{- HLINT ignore "Fuse concatMap/map" -}
112103
{- HLINT ignore "Redundant <$>" -}
113104
{- HLINT ignore "Use fewer imports" -}
@@ -124,7 +115,7 @@ runNode cmdPc = do
124115
configYamlPc <- parseNodeConfigurationFP . getLast $ pncConfigFile cmdPc
125116

126117
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
128119
Right nc' -> return nc'
129120

130121
putStrLn $ "Node configuration: " <> show nc
@@ -133,7 +124,7 @@ runNode cmdPc = do
133124
Just vrfFp -> do vrf <- runExceptT $ checkVRFFilePermissions vrfFp
134125
case vrf of
135126
Left err ->
136-
putStrLn (Text.unpack $ renderVRFPrivateKeyFilePermissionError err) >> exitFailure
127+
putTextLn (renderVRFPrivateKeyFilePermissionError err) >> exitFailure
137128
Right () ->
138129
pure ()
139130
Nothing -> pure ()
@@ -223,10 +214,10 @@ handleNodeWithTracers cmdPc nc p networkMagic runP = do
223214
p
224215

225216
loggingLayer <- case eLoggingLayer of
226-
Left err -> print err >> exitFailure
217+
Left err -> putTextLn (Text.pack $ show err) >> exitFailure
227218
Right res -> return res
228219
!trace <- setupTrace loggingLayer
229-
let tracer = contramap Text.pack $ toLogObject trace
220+
let tracer = contramap pack $ toLogObject trace
230221
logTracingVerbosity nc tracer
231222

232223
-- Legacy logging infrastructure must trace 'nodeStartTime' and 'nodeBasicInfo'.
@@ -291,14 +282,14 @@ setupTrace
291282
:: LoggingLayer
292283
-> IO (Trace IO Text)
293284
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)
297289
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
302293

303294
{-
304295
-- TODO: needs to be finished (issue #4362)
@@ -528,11 +519,11 @@ handleSimpleNode runP p2pMode tracers nc onKernel = do
528519
Signals.Catch $ do
529520
traceWith (startupTracer tracers) NetworkConfigUpdate
530521
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) ->
533524
traceWith (startupTracer tracers)
534525
$ NetworkConfigUpdateError
535-
$ Text.pack $ "Error reading topology configuration file:" <> show err
526+
$ pack "Error reading topology configuration file:" <> err
536527
Right nt -> do
537528
let (localRoots, publicRoots) = producerAddresses nt
538529
traceWith (startupTracer tracers)

0 commit comments

Comments
 (0)