Produce a report for all the data collectors

[ganeti-github.git] / src / Ganeti / Monitoring / Server.hs

diff --git a/src/Ganeti/Monitoring/Server.hs b/src/Ganeti/Monitoring/Server.hs
index 2448d8b..1f311e1 100644 (file)
--- a/src/Ganeti/Monitoring/Server.hs
+++ b/src/Ganeti/Monitoring/Server.hs
@@ -31,7 +31,20 @@ module Ganeti.Monitoring.Server
   , prepMain
   ) where
 
+import Control.Applicative
+import Control.Monad
+import Control.Monad.IO.Class
+import Data.ByteString.Char8 hiding (map, filter, find)
+import Data.List
+import Snap.Core
+import Snap.Http.Server
+import qualified Text.JSON as J
+
+import qualified Ganeti.BasicTypes as BT
 import Ganeti.Daemon
+import qualified Ganeti.DataCollectors.Drbd as Drbd
+import Ganeti.DataCollectors.Types
+import qualified Ganeti.Constants as C
 
 -- * Types and constants definitions
 
@@ -39,7 +52,38 @@ import Ganeti.Daemon
 type CheckResult = ()
 
 -- | Type alias for prepMain results.
-type PrepResult = ()
+type PrepResult = Config Snap ()
+
+-- | Version of the latest supported http API.
+latestAPIVersion :: Int
+latestAPIVersion = 1
+
+-- | Type describing a data collector basic information
+data DataCollector = DataCollector
+  { dName     :: String           -- ^ Name of the data collector
+  , dCategory :: Maybe DCCategory -- ^ Category (storage, instance, ecc)
+                                  --   of the collector
+  , dKind     :: DCKind           -- ^ Kind (performance or status reporting) of
+                                  --   the data collector
+  , dReport   :: IO DCReport      -- ^ Report produced by the collector
+  }
+
+-- | The list of available builtin data collectors.
+collectors :: [DataCollector]
+collectors =
+  [ DataCollector Drbd.dcName Drbd.dcCategory Drbd.dcKind Drbd.dcReport
+  ]
+
+-- * Configuration handling
+
+-- | The default configuration for the HTTP server.
+defaultHttpConf :: Config Snap ()
+defaultHttpConf =
+  setAccessLog (ConfigFileLog C.daemonsExtraLogfilesGanetiMondAccess) .
+  setCompression False .
+  setErrorLog (ConfigFileLog C.daemonsExtraLogfilesGanetiMondError) $
+  setVerbose False
+  emptyConfig
 
 -- * Helper functions
 
@@ -49,9 +93,94 @@ checkMain _ = return $ Right ()
 
 -- | Prepare function for monitoring agent.
 prepMain :: PrepFn CheckResult PrepResult
-prepMain _ _ = return ()
+prepMain opts _ =
+  return $
+    setPort (maybe C.defaultMondPort fromIntegral (optPort opts))
+      defaultHttpConf
+
+-- * Query answers
+
+-- | Reply to the supported API version numbers query.
+versionQ :: Snap ()
+versionQ = writeBS . pack $ J.encode [latestAPIVersion]
+
+-- | Version 1 of the monitoring HTTP API.
+version1Api :: Snap ()
+version1Api =
+  let returnNull = writeBS . pack $ J.encode J.JSNull :: Snap ()
+  in ifTop returnNull <|>
+     route
+       [ ("list", listHandler)
+       , ("report", reportHandler)
+       ]
+
+-- | Get the JSON representation of a data collector to be used in the collector
+-- list.
+dcListItem :: DataCollector -> J.JSValue
+dcListItem dc =
+  J.JSArray
+    [ J.showJSON $ dName dc
+    , maybe J.JSNull J.showJSON $ dCategory dc
+    , J.showJSON $ dKind dc
+    ]
+
+-- | Handler for returning lists.
+listHandler :: Snap ()
+listHandler =
+  dir "collectors" . writeBS . pack . J.encode $ map dcListItem collectors
+
+-- | Handler for returning data collector reports.
+reportHandler :: Snap ()
+reportHandler =
+  route
+    [ ("all", allReports)
+    , (":category/:collector", oneReport)
+    ]
+
+-- | Return the report of all the available collectors.
+allReports :: Snap ()
+allReports = do
+  reports <- mapM (liftIO . dReport) collectors
+  writeBS . pack . J.encode $ reports
+
+-- | Returns a category given its name.
+-- If "collector" is given as the name, the collector has no category, and
+-- Nothing will be returned.
+catFromName :: String -> BT.Result (Maybe DCCategory)
+catFromName "instance"   = BT.Ok $ Just DCInstance
+catFromName "storage"    = BT.Ok $ Just DCStorage
+catFromName "daemon"     = BT.Ok $ Just DCDaemon
+catFromName "hypervisor" = BT.Ok $ Just DCHypervisor
+catFromName "default"    = BT.Ok Nothing
+catFromName _            = BT.Bad "No such category"
+
+-- | Return the report of one collector
+oneReport :: Snap ()
+oneReport = do
+  categoryName <- fmap (maybe mzero unpack) $ getParam "category"
+  collectorName <- fmap (maybe mzero unpack) $ getParam "collector"
+  category <-
+    case catFromName categoryName of
+      BT.Ok cat -> return cat
+      BT.Bad msg -> fail msg
+  collector <-
+    case
+      find (\col -> collectorName == dName col) $
+        filter (\c -> category == dCategory c) collectors of
+      Just col -> return col
+      Nothing -> fail "Unable to find the requested collector"
+  report <- liftIO $ dReport collector
+  writeBS . pack . J.encode $ report
+
+-- | The function implementing the HTTP API of the monitoring agent.
+-- TODO: Currently it only replies to the API version query: implement all the
+-- missing features.
+monitoringApi :: Snap ()
+monitoringApi =
+  ifTop versionQ <|>
+  dir "1" version1Api
 
 -- | Main function.
 main :: MainFn CheckResult PrepResult
-main _ _ _ =
-  return ()
+main _ _ httpConf =
+  httpServe httpConf $ method GET monitoringApi