From e014054315c6049ee132f9db4388ab859e1558ac Mon Sep 17 00:00:00 2001 From: Jordan Millar Date: Wed, 8 Feb 2023 08:26:27 -0400 Subject: [PATCH] Revert "Merge pull request #4855 from input-output-hk/jordan/remove-cli-node-dependency" This reverts commit 75dfd530387023249e5e1563650b6cf3223dccad, reversing changes made to c8862fe0501029d1b3b5469e4bfd6f975aa97256. --- cardano-cli/cardano-cli.cabal | 4 +- cardano-cli/test/Test/Cli/FilePermissions.hs | 80 +------------------- cardano-node/src/Cardano/Node/Run.hs | 71 ++++++++--------- 3 files changed, 34 insertions(+), 121 deletions(-) diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 28331903cc5..26a763a9aa0 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -163,8 +163,6 @@ executable cardano-cli test-suite cardano-cli-test import: project-config - , maybe-Win32 - , maybe-unix hs-source-dirs: test main-is: cardano-cli-test.hs @@ -176,6 +174,7 @@ test-suite cardano-cli-test , cardano-api , cardano-api:gen , cardano-cli + , cardano-node , cardano-prelude , cardano-slotting ^>= 0.1 , containers @@ -188,7 +187,6 @@ test-suite cardano-cli-test , text , time , transformers - , transformers-except , yaml other-modules: Test.Config.Mainnet diff --git a/cardano-cli/test/Test/Cli/FilePermissions.hs b/cardano-cli/test/Test/Cli/FilePermissions.hs index 32d6c5c17da..0c0c0901cce 100644 --- a/cardano-cli/test/Test/Cli/FilePermissions.hs +++ b/cardano-cli/test/Test/Cli/FilePermissions.hs @@ -1,31 +1,14 @@ -{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} -#if !defined(mingw32_HOST_OS) -#define UNIX -#endif - module Test.Cli.FilePermissions ( tests ) where -import Prelude - -import Control.Monad -import Control.Monad.IO.Class -import Control.Monad.Trans.Except -import Control.Monad.Trans.Except.Extra -import Data.Text (Text) -import qualified Data.Text as Text +import Cardano.Prelude -#ifdef UNIX -import System.Posix.Files -import System.Posix.Types (FileMode) -#else -import System.Win32.File -#endif +import Cardano.Node.Run (checkVRFFilePermissions) import Hedgehog (Property, discover, success) import qualified Hedgehog import qualified Hedgehog.Extras.Test.Base as H @@ -57,65 +40,6 @@ prop_createVRFSigningKeyFilePermissions = \file with the wrong permissions: " <> show err Right () -> success -data VRFPrivateKeyFilePermissionError - = OtherPermissionsExist !FilePath - | GroupPermissionsExist !FilePath - | GenericPermissionsExist !FilePath - deriving Show - -renderVRFPrivateKeyFilePermissionError :: VRFPrivateKeyFilePermissionError -> Text -renderVRFPrivateKeyFilePermissionError err = - case err of - OtherPermissionsExist fp -> - "VRF private key file at: " <> Text.pack fp - <> " has \"other\" file permissions. Please remove all \"other\" file permissions." - - GroupPermissionsExist fp -> - "VRF private key file at: " <> Text.pack fp - <> "has \"group\" file permissions. Please remove all \"group\" file permissions." - GenericPermissionsExist fp -> - "VRF private key file at: " <> Text.pack fp - <> "has \"generic\" file permissions. Please remove all \"generic\" file permissions." - - --- | Make sure the VRF private key file is readable only --- by the current process owner the node is running under. -checkVRFFilePermissions :: FilePath -> ExceptT VRFPrivateKeyFilePermissionError IO () -#ifdef UNIX -checkVRFFilePermissions vrfPrivKey = do - fs <- liftIO $ getFileStatus vrfPrivKey - let fm = fileMode fs - -- Check the the VRF private key file does not give read/write/exec permissions to others. - when (hasOtherPermissions fm) - (left $ OtherPermissionsExist vrfPrivKey) - -- Check the the VRF private key file does not give read/write/exec permissions to any group. - when (hasGroupPermissions fm) - (left $ GroupPermissionsExist vrfPrivKey) - where - hasPermission :: FileMode -> FileMode -> Bool - hasPermission fModeA fModeB = fModeA `intersectFileModes` fModeB /= nullFileMode - - hasOtherPermissions :: FileMode -> Bool - hasOtherPermissions fm' = fm' `hasPermission` otherModes - - hasGroupPermissions :: FileMode -> Bool - hasGroupPermissions fm' = fm' `hasPermission` groupModes -#else -checkVRFFilePermissions vrfPrivKey = do - attribs <- liftIO $ getFileAttributes vrfPrivKey - -- https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea - -- https://docs.microsoft.com/en-us/windows/win32/fileio/file-access-rights-constants - -- https://docs.microsoft.com/en-us/windows/win32/secauthz/standard-access-rights - -- https://docs.microsoft.com/en-us/windows/win32/secauthz/generic-access-rights - -- https://docs.microsoft.com/en-us/windows/win32/secauthz/access-mask - when (attribs `hasPermission` genericPermissions) - (left $ GenericPermissionsExist vrfPrivKey) - where - genericPermissions = gENERIC_ALL .|. gENERIC_READ .|. gENERIC_WRITE .|. gENERIC_EXECUTE - hasPermission fModeA fModeB = fModeA .&. fModeB /= gENERIC_NONE -#endif - - -- ----------------------------------------------------------------------------- tests :: IO Bool diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs index 42cb4e06aaa..00a7a0a9d39 100644 --- a/cardano-node/src/Cardano/Node/Run.hs +++ b/cardano-node/src/Cardano/Node/Run.hs @@ -19,24 +19,15 @@ module Cardano.Node.Run ) where import qualified Cardano.Api as Api -import Prelude +import Cardano.Prelude hiding (ByteString, STM, atomically, show, take, trace) +import Data.IP (toSockAddr) +import Prelude (String, id, show) -import Control.Concurrent import Control.Concurrent.Class.MonadSTM.Strict -import Control.Exception -import Control.Monad -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Trans.Except -import Control.Monad.Trans.Except.Extra +import Control.Monad.Trans.Except.Extra (left) import "contra-tracer" Control.Tracer -import Data.Either -import Data.IP (toSockAddr) -import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map -import Data.Maybe -import Data.Monoid -import Data.Proxy -import Data.Text (Text) +import Data.Text (breakOn, pack, take) import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import Data.Time.Clock (getCurrentTime) @@ -46,7 +37,6 @@ import Network.HostName (getHostName) import Network.Socket (Socket) import System.Directory (canonicalizePath, createDirectoryIfMissing, makeAbsolute) import System.Environment (lookupEnv) -import System.Exit #ifdef UNIX import GHC.Weak (deRefWeak) @@ -71,23 +61,12 @@ import Cardano.Node.Configuration.NodeAddress import Cardano.Node.Configuration.POM (NodeConfiguration (..), PartialNodeConfiguration (..), SomeNetworkP2PMode (..), defaultPartialNodeConfiguration, makeNodeConfiguration, parseNodeConfigurationFP) -import Cardano.Node.Configuration.Socket (SocketOrSocketInfo (..), - gatherConfiguredSockets, getSocketOrSocketInfoAddr) -import qualified Cardano.Node.Configuration.Topology as TopologyNonP2P -import Cardano.Node.Configuration.TopologyP2P -import qualified Cardano.Node.Configuration.TopologyP2P as TopologyP2P -import Cardano.Node.Handlers.Shutdown -import Cardano.Node.Protocol (mkConsensusProtocol) -import Cardano.Node.Protocol.Types -import Cardano.Node.Queries import Cardano.Node.Startup -import Cardano.Node.TraceConstraints (TraceConstraints) import Cardano.Node.Tracing.API import Cardano.Node.Tracing.StateRep (NodeState (NodeKernelOnline)) import Cardano.Node.Tracing.Tracers.Startup (getStartupInfo) import Cardano.Node.Types import Cardano.Tracing.Config (TraceOptions (..), TraceSelection (..)) -import Cardano.Tracing.Tracers import qualified Ouroboros.Consensus.Config as Consensus import Ouroboros.Consensus.Config.SupportsNode (ConfigSupportsNode (..)) @@ -108,6 +87,18 @@ import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPo import Ouroboros.Network.Subscription (DnsSubscriptionTarget (..), IPSubscriptionTarget (..)) +import Cardano.Node.Configuration.Socket (SocketOrSocketInfo (..), + gatherConfiguredSockets, getSocketOrSocketInfoAddr) +import qualified Cardano.Node.Configuration.Topology as TopologyNonP2P +import Cardano.Node.Configuration.TopologyP2P +import qualified Cardano.Node.Configuration.TopologyP2P as TopologyP2P +import Cardano.Node.Handlers.Shutdown +import Cardano.Node.Protocol (mkConsensusProtocol) +import Cardano.Node.Protocol.Types +import Cardano.Node.Queries +import Cardano.Node.TraceConstraints (TraceConstraints) +import Cardano.Tracing.Tracers + {- HLINT ignore "Fuse concatMap/map" -} {- HLINT ignore "Redundant <$>" -} {- HLINT ignore "Use fewer imports" -} @@ -124,7 +115,7 @@ runNode cmdPc = do configYamlPc <- parseNodeConfigurationFP . getLast $ pncConfigFile cmdPc nc <- case makeNodeConfiguration $ defaultPartialNodeConfiguration <> configYamlPc <> cmdPc of - Left err -> error $ "Error in creating the NodeConfiguration: " <> err + Left err -> panic $ "Error in creating the NodeConfiguration: " <> Text.pack err Right nc' -> return nc' putStrLn $ "Node configuration: " <> show nc @@ -133,7 +124,7 @@ runNode cmdPc = do Just vrfFp -> do vrf <- runExceptT $ checkVRFFilePermissions vrfFp case vrf of Left err -> - putStrLn (Text.unpack $ renderVRFPrivateKeyFilePermissionError err) >> exitFailure + putTextLn (renderVRFPrivateKeyFilePermissionError err) >> exitFailure Right () -> pure () Nothing -> pure () @@ -223,10 +214,10 @@ handleNodeWithTracers cmdPc nc p networkMagic runP = do p loggingLayer <- case eLoggingLayer of - Left err -> print err >> exitFailure + Left err -> putTextLn (Text.pack $ show err) >> exitFailure Right res -> return res !trace <- setupTrace loggingLayer - let tracer = contramap Text.pack $ toLogObject trace + let tracer = contramap pack $ toLogObject trace logTracingVerbosity nc tracer -- Legacy logging infrastructure must trace 'nodeStartTime' and 'nodeBasicInfo'. @@ -291,14 +282,14 @@ setupTrace :: LoggingLayer -> IO (Trace IO Text) setupTrace loggingLayer = do - hn <- maybe hostname (return . Text.pack) =<< lookupEnv "CARDANO_NODE_LOGGING_HOSTNAME" - return . setHostname hn $ - llAppendName loggingLayer "node" (llBasicTrace loggingLayer) + hn <- maybe hostname (pure . pack) =<< lookupEnv "CARDANO_NODE_LOGGING_HOSTNAME" + return $ + setHostname hn $ + llAppendName loggingLayer "node" (llBasicTrace loggingLayer) where - hostname :: IO Text - hostname = do - hn0 <- Text.pack <$> getHostName - return $ Text.take 8 $ fst $ Text.breakOn "." hn0 + hostname = do + hn0 <- pack <$> getHostName + return $ take 8 $ fst $ breakOn "." hn0 {- -- TODO: needs to be finished (issue #4362) @@ -528,11 +519,11 @@ handleSimpleNode runP p2pMode tracers nc onKernel = do Signals.Catch $ do traceWith (startupTracer tracers) NetworkConfigUpdate result <- try $ TopologyP2P.readTopologyFileOrError (startupTracer tracers) nc - case result :: Either IOException NetworkTopology of - Left err -> + case result of + Left (FatalError err) -> traceWith (startupTracer tracers) $ NetworkConfigUpdateError - $ Text.pack $ "Error reading topology configuration file:" <> show err + $ pack "Error reading topology configuration file:" <> err Right nt -> do let (localRoots, publicRoots) = producerAddresses nt traceWith (startupTracer tracers)