diff --git a/app/Main.hs b/app/Main.hs index d3bfeb6..4af7536 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,6 +1,6 @@ module Main where -import qualified Lhp.Cli as Cli +import qualified HostPatrol.Cli as Cli import System.Exit (exitWith) diff --git a/src/Lhp/Cli.hs b/src/HostPatrol/Cli.hs similarity index 96% rename from src/Lhp/Cli.hs rename to src/HostPatrol/Cli.hs index 51103f5..ff2c570 100644 --- a/src/Lhp/Cli.hs +++ b/src/HostPatrol/Cli.hs @@ -2,7 +2,7 @@ {-# LANGUAGE TypeApplications #-} -- | This module provides top-level definitions for the CLI program. -module Lhp.Cli where +module HostPatrol.Cli where import qualified Autodocodec.Schema as ADC.Schema import Control.Applicative ((<**>)) @@ -12,10 +12,10 @@ import qualified Data.Aeson as Aeson import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Data.Text as T import qualified Data.Text.IO as TIO -import qualified Lhp.Config as Config -import qualified Lhp.Meta as Meta -import Lhp.Remote (compileReport) -import Lhp.Types (Report) +import qualified HostPatrol.Config as Config +import qualified HostPatrol.Meta as Meta +import HostPatrol.Remote (compileReport) +import HostPatrol.Types (Report) import Options.Applicative ((<|>)) import qualified Options.Applicative as OA import System.Exit (ExitCode (..)) diff --git a/src/Lhp/Config.hs b/src/HostPatrol/Config.hs similarity index 98% rename from src/Lhp/Config.hs rename to src/HostPatrol/Config.hs index d2c2df0..75043ce 100644 --- a/src/Lhp/Config.hs +++ b/src/HostPatrol/Config.hs @@ -4,7 +4,7 @@ -- | This module defines public data and type definitions to represent -- application configuration. -module Lhp.Config where +module HostPatrol.Config where import qualified Autodocodec as ADC import qualified Data.Aeson as Aeson diff --git a/src/Lhp/Meta.hs b/src/HostPatrol/Meta.hs similarity index 99% rename from src/Lhp/Meta.hs rename to src/HostPatrol/Meta.hs index 006b63b..e76484d 100644 --- a/src/Lhp/Meta.hs +++ b/src/HostPatrol/Meta.hs @@ -4,7 +4,7 @@ {-# LANGUAGE TemplateHaskell #-} -- | This module provides project metadata information definitions. -module Lhp.Meta where +module HostPatrol.Meta where import Data.Aeson (ToJSON (toEncoding)) import qualified Data.Aeson as Aeson diff --git a/src/Lhp/Remote.hs b/src/HostPatrol/Remote.hs similarity index 90% rename from src/Lhp/Remote.hs rename to src/HostPatrol/Remote.hs index e381a48..1a4239a 100644 --- a/src/Lhp/Remote.hs +++ b/src/HostPatrol/Remote.hs @@ -5,7 +5,7 @@ -- | This module provides definitions to retrieve and parse remote -- host information and produce host report. -module Lhp.Remote where +module HostPatrol.Remote where import Control.Monad.Except (ExceptT, MonadError (..), runExceptT) import Control.Monad.IO.Class (MonadIO (liftIO)) @@ -20,9 +20,8 @@ import qualified Data.List as List import Data.Maybe (catMaybes, fromMaybe) import qualified Data.Scientific as S import qualified Data.Text as T -import qualified Lhp.Config as Config -import Lhp.Types (HostReport (_hostReportTimezone)) -import qualified Lhp.Types as Types +import qualified HostPatrol.Config as Config +import qualified HostPatrol.Types as Types import System.Exit (ExitCode (..)) import System.IO (hPutStrLn, stderr) import qualified System.Process.Typed as TP @@ -36,7 +35,7 @@ import qualified Zamazingo.Text as Z.Text -- | Attempts to compile host patrol report for a given configuration. compileReport - :: MonadError LhpError m + :: MonadError HostPatrolError m => MP.MonadParallel m => MonadIO m => Bool @@ -60,7 +59,7 @@ compileReport par Config.Config {..} = do -- report. compileHostReport :: MonadIO m - => MonadError LhpError m + => MonadError HostPatrolError m => Config.HostSpec -> m Types.HostReport compileHostReport ch = do @@ -83,7 +82,7 @@ compileHostReport ch = do -- | Consumes a 'Config.HostSpec' and produces a 'Types.Host'. _makeHostFromConfigHostSpec - :: MonadError LhpError m + :: MonadError HostPatrolError m => MonadIO m => Config.HostSpec -> m Types.Host @@ -104,17 +103,17 @@ _makeHostFromConfigHostSpec Config.HostSpec {..} = -- | Data definition for error(s) which can be thrown while retrieving -- remote host information and producing host report. -data LhpError - = LhpErrorSsh Z.Ssh.Destination Z.Ssh.SshError - | LhpErrorParse Z.Ssh.Destination T.Text - | LhpErrorUnknown T.Text +data HostPatrolError + = HostPatrolErrorSsh Z.Ssh.Destination Z.Ssh.SshError + | HostPatrolErrorParse Z.Ssh.Destination T.Text + | HostPatrolErrorUnknown T.Text deriving (Eq, Show) -instance Aeson.ToJSON LhpError where - toJSON (LhpErrorSsh h err) = Aeson.object [("type", "ssh"), "host" Aeson..= h, "error" Aeson..= err] - toJSON (LhpErrorParse h err) = Aeson.object [("type", "parse"), "host" Aeson..= h, "error" Aeson..= err] - toJSON (LhpErrorUnknown err) = Aeson.object [("type", "unknown"), "error" Aeson..= err] +instance Aeson.ToJSON HostPatrolError where + toJSON (HostPatrolErrorSsh h err) = Aeson.object [("type", "ssh"), "host" Aeson..= h, "error" Aeson..= err] + toJSON (HostPatrolErrorParse h err) = Aeson.object [("type", "parse"), "host" Aeson..= h, "error" Aeson..= err] + toJSON (HostPatrolErrorUnknown err) = Aeson.object [("type", "unknown"), "error" Aeson..= err] -- * Internal @@ -133,7 +132,7 @@ getHostSshConfig Types.Host {..} = -- list of key/value tuples. _fetchHostInfo :: MonadIO m - => MonadError LhpError m + => MonadError HostPatrolError m => Types.Host -> m [(T.Text, T.Text)] _fetchHostInfo h@Types.Host {..} = @@ -144,7 +143,7 @@ _fetchHostInfo h@Types.Host {..} = -- as a list of key/value tuples. _fetchHostCloudInfo :: MonadIO m - => MonadError LhpError m + => MonadError HostPatrolError m => Types.Host -> m [(T.Text, T.Text)] _fetchHostCloudInfo h@Types.Host {..} = @@ -157,7 +156,7 @@ _fetchHostCloudInfo h@Types.Host {..} = -- host, a list of rudimentary Docker container information otherwise. _fetchHostDockerContainers :: MonadIO m - => MonadError LhpError m + => MonadError HostPatrolError m => Types.Host -> m (Maybe [Types.DockerContainer]) _fetchHostDockerContainers h@Types.Host {..} = @@ -166,7 +165,7 @@ _fetchHostDockerContainers h@Types.Host {..} = prog = _toSshError _hostName (Z.Ssh.runScript (getHostSshConfig h) $(embedStringFile "src/scripts/docker-containers.sh") ["bash"]) _parseDockerContainers b = case ACD.eitherDecode (ACD.list _jsonDecoderDockerContainer) b of - Left err -> throwError (LhpErrorParse _hostName ("Error while parsing containers information: " <> T.pack err)) + Left err -> throwError (HostPatrolErrorParse _hostName ("Error while parsing containers information: " <> T.pack err)) Right sv -> pure sv @@ -174,7 +173,7 @@ _fetchHostDockerContainers h@Types.Host {..} = -- host. _fetchHostPublicSshHostKeys :: MonadIO m - => MonadError LhpError m + => MonadError HostPatrolError m => Types.Host -> m [T.Text] _fetchHostPublicSshHostKeys h@Types.Host {..} = @@ -187,7 +186,7 @@ _fetchHostPublicSshHostKeys h@Types.Host {..} = -- host. _fetchHostAuthorizedSshKeys :: MonadIO m - => MonadError LhpError m + => MonadError HostPatrolError m => Types.Host -> m [T.Text] _fetchHostAuthorizedSshKeys h@Types.Host {..} = @@ -200,7 +199,7 @@ _fetchHostAuthorizedSshKeys h@Types.Host {..} = -- host. _fetchHostSystemdServices :: MonadIO m - => MonadError LhpError m + => MonadError HostPatrolError m => Types.Host -> m [T.Text] _fetchHostSystemdServices h@Types.Host {..} = @@ -213,7 +212,7 @@ _fetchHostSystemdServices h@Types.Host {..} = -- host. _fetchHostSystemdTimers :: MonadIO m - => MonadError LhpError m + => MonadError HostPatrolError m => Types.Host -> m [T.Text] _fetchHostSystemdTimers h@Types.Host {..} = @@ -224,7 +223,7 @@ _fetchHostSystemdTimers h@Types.Host {..} = -- | Smart constructor for remote host cloud information. _mkCloud - :: MonadError LhpError m + :: MonadError HostPatrolError m => Z.Ssh.Destination -> [(T.Text, T.Text)] -> m Types.Cloud @@ -246,7 +245,7 @@ _mkCloud h kvs = -- | Smart constructor for remote host rudimentary hardware -- information. _mkHardware - :: MonadError LhpError m + :: MonadError HostPatrolError m => Z.Ssh.Destination -> [(T.Text, T.Text)] -> m Types.Hardware @@ -260,7 +259,7 @@ _mkHardware h kvs = -- | Smart constructor for remote host kernel information. _mkKernel - :: MonadError LhpError m + :: MonadError HostPatrolError m => Z.Ssh.Destination -> [(T.Text, T.Text)] -> m Types.Kernel @@ -277,7 +276,7 @@ _mkKernel h kvs = -- | Smart constructor for remote host distribution information. _mkDistribution - :: MonadError LhpError m + :: MonadError HostPatrolError m => Z.Ssh.Destination -> [(T.Text, T.Text)] -> m Types.Distribution @@ -409,26 +408,26 @@ _parseRead = either (throwError . T.pack) pure . readEither . T.unpack --- | Lifts @'ExceptT' 'T.Text'@ to @'MonadError' 'LhpError'@ with +-- | Lifts @'ExceptT' 'T.Text'@ to @'MonadError' 'HostPatrolError'@ with -- parse error. _toParseError - :: MonadError LhpError m + :: MonadError HostPatrolError m => Z.Ssh.Destination -> ExceptT T.Text m a -> m a _toParseError h = - _modifyError (LhpErrorParse h) + _modifyError (HostPatrolErrorParse h) --- | Lifts @'ExceptT' 'Z.Ssh.SshError'@ to @'MonadError' 'LhpError'@ +-- | Lifts @'ExceptT' 'Z.Ssh.SshError'@ to @'MonadError' 'HostPatrolError'@ -- with SSH error. _toSshError - :: MonadError LhpError m + :: MonadError HostPatrolError m => Z.Ssh.Destination -> ExceptT Z.Ssh.SshError m a -> m a _toSshError h = - _modifyError (LhpErrorSsh h) + _modifyError (HostPatrolErrorSsh h) -- | Creates list of 'Types.SshPublicKey' from given 'T.Text' using @ssh-keygen@. @@ -447,7 +446,7 @@ _toSshError h = -- >>> runExceptT $ parseSshPublicKeys "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILdd2ubdTn5LPsN0zaxylrpkQTW+1Vr/uWQaEQXoGkd3 some more comment" -- Right [SshPublicKey {_sshPublicKeyData = "ssh-ed25519 AAAAC3NzaC1lZDI1NTE5AAAAILdd2ubdTn5LPsN0zaxylrpkQTW+1Vr/uWQaEQXoGkd3 some more comment", _sshPublicKeyType = "ED25519", _sshPublicKeyLength = 256, _sshPublicKeyComment = "some more comment", _sshPublicKeyFingerprint = "MD5:ec:4b:ff:8d:c7:43:a9:ab:16:9f:0d:fa:8f:e2:6f:6c"}] parseSshPublicKeys - :: MonadError LhpError m + :: MonadError HostPatrolError m => MonadIO m => T.Text -> m [Types.SshPublicKey] @@ -464,7 +463,7 @@ parseSshPublicKeys s = do -- | Attempts to create 'Types.SshPublicKey' from given SSH public key -- represented as 'T.Text' using @ssh-keygen@. parseSshPublicKey - :: MonadError LhpError m + :: MonadError HostPatrolError m => MonadIO m => T.Text -> m Types.SshPublicKey @@ -484,7 +483,7 @@ parseSshPublicKey s = do } _ -> throwUnknown "Could not parse ssh-keygen output." where - throwUnknown = throwError . LhpErrorUnknown + throwUnknown = throwError . HostPatrolErrorUnknown stdin = TP.byteStringInput (Z.Text.blFromText s) process = TP.setStdin stdin (TP.proc "ssh-keygen" ["-E", "md5", "-l", "-f", "-"]) @@ -492,7 +491,7 @@ parseSshPublicKey s = do -- | Attempts to get the list of SSH public keys from GitHub for a -- given GitHub username. listGitHubSshKeys - :: MonadError LhpError m + :: MonadError HostPatrolError m => MonadIO m => T.Text -> m [T.Text] @@ -502,6 +501,6 @@ listGitHubSshKeys u = do ExitFailure _ -> throwUnknown (Z.Text.unsafeTextFromBL err) ExitSuccess -> pure (toKeys out) where - throwUnknown = throwError . LhpErrorUnknown + throwUnknown = throwError . HostPatrolErrorUnknown process = TP.proc "curl" ["-s", "https://github.com/" <> T.unpack u <> ".keys"] toKeys = filter (not . T.null) . T.lines . Z.Text.unsafeTextFromBL diff --git a/src/Lhp/Types.hs b/src/HostPatrol/Types.hs similarity index 99% rename from src/Lhp/Types.hs rename to src/HostPatrol/Types.hs index 8f7e836..07a406c 100644 --- a/src/Lhp/Types.hs +++ b/src/HostPatrol/Types.hs @@ -4,7 +4,7 @@ -- | This module defines public data and type definitions to represent -- a complete Host Patrol report. -module Lhp.Types where +module HostPatrol.Types where import qualified Autodocodec as ADC import qualified Data.Aeson as Aeson