From 39e047ccd8422207e01247c63f514c40e7eac31e Mon Sep 17 00:00:00 2001 From: Michael Orlitzky Date: Thu, 15 May 2014 21:36:43 -0400 Subject: [PATCH] Add SQLite support (default if a filename is given as the database). Make the summary/default queries configurable. --- doc/TODO | 8 ++---- doc/mailbox-countrc.example | 28 +++++++++++++++++---- src/CommandLine.hs | 41 +++++++++++++++++++----------- src/Configuration.hs | 18 ++++++++++++++ src/Main.hs | 25 +++++++++++-------- src/OptionalConfiguration.hs | 10 ++++++++ src/Report.hs | 48 ++++++++++++++++++++++-------------- 7 files changed, 123 insertions(+), 55 deletions(-) diff --git a/doc/TODO b/doc/TODO index 95533d5..d5cd573 100644 --- a/doc/TODO +++ b/doc/TODO @@ -1,7 +1,3 @@ -1. Don't add things to the connection string if they're empty. +1. Add everything to the man page. -2. Make the summary/detail queries optional. - -3. Add everything to the man page. - -4. Come up with a better cabal description field. +2. Come up with a better cabal description field. diff --git a/doc/mailbox-countrc.example b/doc/mailbox-countrc.example index 8a3529d..3e9559d 100644 --- a/doc/mailbox-countrc.example +++ b/doc/mailbox-countrc.example @@ -2,7 +2,7 @@ # Sample configuration file for mailbox-count. # -# The name of the database to which we should connect. +# The name of the database (or file, if SQLite) to which we should connect. # # Default: The name of the current user (Postgres only) # @@ -16,28 +16,46 @@ # detail = true -# Hostname where the database is located. +# SQL query used to produce the detail report. This should return the +# set of all (domain, username) pairs. See the default value for an +# example. +# +# Default: "SELECT domain,username FROM mailbox ORDER BY domain;" +# +# detail_query = "SELECT domain,username FROM mailbox LIMIT 1000;" + + +# Hostname where the database is located (postgres-only). # # Default: None, a UNIX domain socket connection is attempted (Postgres only) # # host = "localhost" -# Password used to connect to the database. +# Password used to connect to the database (postgres-only). # # Default: None (assumes passwordless authentication) # # password = "hunter2" -# Port number used to connect to the database. +# Port number used to connect to the database (postgres-only). # # Default: None, a UNIX domain socket connection is attempted (Postgres only) # # port = 5432 -# Username used to connect to the database. +# SQL query used to produce the summary report. This should return +# (domain, user count) pairs. See the default value for an +# example. +# +# Default: "SELECT domain,COUNT(username) FROM mailbox GROUP BY domain ORDER BY domain;" +# +# summary_query = "SELECT domain,COUNT(username) as cnt GROUP BY domain ORDER by cnt;" + + +# Username used to connect to the database (postgres-only). # # Default: The current user # diff --git a/src/CommandLine.hs b/src/CommandLine.hs index 578179e..6fb30fe 100644 --- a/src/CommandLine.hs +++ b/src/CommandLine.hs @@ -30,39 +30,50 @@ my_summary = program_name ++ "-" ++ (showVersion version) database_help :: String database_help = - "The name of the database to which we should connect" + "The name of the database (or file, if SQLite) to which we should connect" detail_help :: String detail_help = "Produce a detailed report listing all mailboxes by domain" +detail_query_help :: String +detail_query_help = + "SQL query used to produce the detail report" + host_help :: String host_help = - "Hostname where the database is located" + "Hostname where the database is located (postgres-only)" password_help :: String password_help = - "Password used to connect to the database" + "Password used to connect to the database (postgres-only)" port_help :: String port_help = - "Port number used to connect to the database" + "Port number used to connect to the database (postgres-only)" + +summary_query_help :: String +summary_query_help = + "SQL query used to produce the summary report" username_help :: String username_help = - "Username used to connect to the database" + "Username used to connect to the database (postgres-only)" arg_spec :: OptionalConfiguration -arg_spec = OptionalConfiguration - { database = def &= help database_help, - detail = def &= help detail_help, - host = def &= help host_help, - password = def &= help password_help, - port = def &= help port_help, - username = def &= help username_help } - &= program program_name - &= summary my_summary - &= details [description] +arg_spec = + OptionalConfiguration { + database = def &= help database_help, + detail = def &= help detail_help, + detail_query = def &= help detail_query_help, + host = def &= help host_help, + password = def &= help password_help, + port = def &= help port_help, + summary_query = def &= help summary_query_help, + username = def &= help username_help } + &= program program_name + &= summary my_summary + &= details [description] get_args :: IO OptionalConfiguration get_args = cmdArgs arg_spec diff --git a/src/Configuration.hs b/src/Configuration.hs index 8b6a7ce..f07be70 100644 --- a/src/Configuration.hs +++ b/src/Configuration.hs @@ -20,26 +20,42 @@ data Configuration = Configuration { database :: Maybe String, detail :: Bool, + detail_query :: String, host :: Maybe String, password :: Maybe String, port :: Maybe Int, + summary_query :: String, username :: Maybe String } deriving (Show) + -- | A Configuration with all of its fields set to their default -- values. +-- instance Default Configuration where def = Configuration { database = def, detail = def, + detail_query = def_detail_query, host = def, password = def, port = def, + summary_query = def_summary_query, username = def } + where + def_summary_query = "SELECT domain,COUNT(username) " ++ + "FROM mailbox " ++ + "GROUP BY domain "++ + "ORDER BY domain;" + + def_detail_query = "SELECT domain,username " ++ + "FROM mailbox " ++ + "ORDER BY domain;" -- | Merge a 'Configuration' with an 'OptionalConfiguration'. This is -- more or less the Monoid instance for 'OptionalConfiguration', but -- since the two types are different, we have to repeat ourselves. +-- merge_optional :: Configuration -> OC.OptionalConfiguration -> Configuration @@ -47,9 +63,11 @@ merge_optional cfg opt_cfg = Configuration (OC.merge_maybes (database cfg) (OC.database opt_cfg)) (merge (detail cfg) (OC.detail opt_cfg)) + (merge (detail_query cfg) (OC.detail_query opt_cfg)) (OC.merge_maybes (host cfg) (OC.host opt_cfg)) (OC.merge_maybes (password cfg) (OC.password opt_cfg)) (OC.merge_maybes (port cfg) (OC.port opt_cfg)) + (merge (summary_query cfg) (OC.summary_query opt_cfg)) (OC.merge_maybes (username cfg) (OC.username opt_cfg)) where -- | If the thing on the right is Just something, return that diff --git a/src/Main.hs b/src/Main.hs index d153716..f00ebb3 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,3 +1,5 @@ +{-# LANGUAGE DoAndIfThenElse #-} +{-# LANGUAGE NoMonomorphismRestriction #-} module Main where @@ -5,13 +7,16 @@ import Data.Maybe ( fromMaybe ) import Data.Monoid ( (<>) ) import Data.String.Utils ( join ) import Database.HDBC.PostgreSQL ( connectPostgreSQL ) +import Database.HDBC.Sqlite3 ( connectSqlite3 ) import System.Console.CmdArgs ( def ) +import System.Directory ( doesFileExist ) import CommandLine ( get_args ) import Configuration ( Configuration(..), merge_optional ) import qualified OptionalConfiguration as OC ( from_rc ) import Report ( report ) + -- | Construct a connection string (postgres-only, for now) from a -- 'Configuration'. All of these are optional, at least for -- Postgres, and so we want to avoid appending e.g. \"host=\" to the @@ -58,16 +63,16 @@ main = do -- log the errors. let cfg = (def :: Configuration) `merge_optional` opt_config - -- Check the optional config for missing required options. - --when (isNothing (OC.password opt_config)) $ do - -- report_error "No password supplied." - -- exitWith (ExitFailure exit_no_password) + -- If a database name was specified, and that name exists as a file + -- on the system, assume that the user wanted to use SQLite. + r <- case (database cfg) of + Nothing -> connectPostgreSQL (connection_string cfg) >>= report cfg - --when (isNothing (OC.username opt_config)) $ do - -- report_error "No username supplied." - --exitWith (ExitFailure exit_no_username) + Just dbname -> do + exists <- doesFileExist dbname + if exists + then connectSqlite3 dbname >>= report cfg + else connectPostgreSQL (connection_string cfg) >>= report cfg - conn <- connectPostgreSQL (connection_string cfg) - r <- report conn (detail cfg) + -- The DB connection is implicitly closed when it gets garbage collected. putStrLn r --- disconnect conn diff --git a/src/OptionalConfiguration.hs b/src/OptionalConfiguration.hs index 0bd093b..2d74d27 100644 --- a/src/OptionalConfiguration.hs +++ b/src/OptionalConfiguration.hs @@ -36,9 +36,11 @@ data OptionalConfiguration = OptionalConfiguration { database :: Maybe String, detail :: Maybe Bool, + detail_query :: Maybe String, host :: Maybe String, password :: Maybe String, port :: Maybe Int, + summary_query :: Maybe String, username :: Maybe String } deriving (Show, Data, Typeable) @@ -70,15 +72,19 @@ instance Monoid OptionalConfiguration where Nothing Nothing Nothing + Nothing + Nothing -- | Combine @cfg1@ and @cfg2@, giving precedence to @cfg2@. cfg1 `mappend` cfg2 = OptionalConfiguration (merge_maybes (database cfg1) (database cfg2)) (merge_maybes (detail cfg1) (detail cfg2)) + (merge_maybes (detail_query cfg1) (detail_query cfg2)) (merge_maybes (host cfg1) (host cfg2)) (merge_maybes (password cfg1) (password cfg2)) (merge_maybes (port cfg1) (port cfg2)) + (merge_maybes (summary_query cfg1) (summary_query cfg2)) (merge_maybes (username cfg1) (username cfg2)) @@ -106,15 +112,19 @@ from_rc = do DC.Optional user_config_path ] cfg_database <- DC.lookup cfg "database" cfg_detail <- DC.lookup cfg "detail" + cfg_detail_query <- DC.lookup cfg "detail_query" cfg_host <- DC.lookup cfg "host" cfg_password <- DC.lookup cfg "password" cfg_port <- DC.lookup cfg "port" + cfg_summary_query <- DC.lookup cfg "summary_query" cfg_username <- DC.lookup cfg "username" return $ OptionalConfiguration cfg_database cfg_detail + cfg_detail_query cfg_host cfg_password cfg_port + cfg_summary_query cfg_username diff --git a/src/Report.hs b/src/Report.hs index 76373a7..f1ec9dd 100644 --- a/src/Report.hs +++ b/src/Report.hs @@ -15,9 +15,11 @@ import Database.HDBC ( safeFromSql, quickQuery ) import Database.HDBC.Sqlite3 ( connectSqlite3 ) +import System.Console.CmdArgs.Default ( Default(..) ) import Test.Tasty ( TestTree, testGroup ) import Test.Tasty.HUnit ( (@?=), testCase ) +import Configuration ( Configuration(..) ) -- Type synonyms to make the signatures below a little more clear. type Domain = String @@ -107,12 +109,18 @@ format_domain_count longest_length (DomainCount d c) = where num_spaces = longest_length - length d + +-- | The header that gets output before the summary report. +-- summary_header :: String summary_header = "Summary (number of mailboxes per domain)\n" ++ "----------------------------------------" -report_summary :: IConnection a => a -> IO String -report_summary conn = do + +-- | Given a connection, produces the summary report as a 'String'. +-- +report_summary :: IConnection a => a -> String -> IO String +report_summary conn query = do list_rows <- quickQuery conn query [] let maybe_domain_counts = map list_to_domain_count list_rows let domain_counts = catMaybes maybe_domain_counts @@ -136,10 +144,6 @@ report_summary conn = do where longest = maximumBy compare_dcs_by_length dcs - query = "SELECT domain,COUNT(username) " ++ - "FROM mailbox " ++ - "GROUP BY domain "++ - "ORDER BY domain;" -- | Construct a Domain -> [Username] (a DomainUserMap) map from a @@ -176,12 +180,17 @@ construct_domain_user_map = Map.alter (append_func user) domain du_map +-- | The header that gets output before the detail report. +-- detail_header :: String detail_header = "Detail (list of all mailboxes by domain)\n" ++ "----------------------------------------" -report_detail :: IConnection a => a -> IO String -report_detail conn = do + +-- | Given a connection, produces the detail report as a 'String'. +-- +report_detail :: IConnection a => a -> String -> IO String +report_detail conn query = do list_rows <- quickQuery conn query [] let maybe_domain_users = map list_to_domain_user list_rows let domain_users = catMaybes maybe_domain_users @@ -192,10 +201,6 @@ report_detail conn = do let report_body = Map.foldl (++) "" domain_report_map return $ detail_header ++ report_body where - query = "SELECT domain,username " ++ - "FROM mailbox " ++ - "ORDER BY domain;" - format_domain :: Domain -> [Username] -> String format_domain domain users = (join "\n" (domain_header : indented_users)) ++ "\n" @@ -205,11 +210,14 @@ report_detail conn = do indented_users = map (" " ++) users -report :: IConnection a => a -> Bool -> IO String -report conn do_detail = - if do_detail - then report_detail conn - else report_summary conn +-- | Given a connection and a 'Configuration', produces the report as +-- a 'String'. +-- +report :: IConnection a => Configuration -> a -> IO String +report cfg conn = + if (detail cfg) + then report_detail conn (detail_query cfg) + else report_summary conn (summary_query cfg) @@ -224,7 +232,8 @@ test_summary_report :: TestTree test_summary_report = testCase desc $ do conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3" - actual <- report_summary conn + let cfg = def :: Configuration + actual <- report_summary conn (summary_query cfg) actual @?= expected where desc = "Summary report looks like it should" @@ -240,7 +249,8 @@ test_detail_report :: TestTree test_detail_report = testCase desc $ do conn <- connectSqlite3 "test/fixtures/postfixadmin.sqlite3" - actual <- report_detail conn + let cfg = def :: Configuration + actual <- report_detail conn (detail_query cfg) actual @?= expected where desc = "Detail report looks like it should" -- 2.43.2