src/Ganeti/Monitoring/Server.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 {-| Implementation of the Ganeti confd server functionality.
   4
   5 -}
   6
   7 {-
   8
   9 Copyright (C) 2013 Google Inc.
  10
  11 This program is free software; you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation; either version 2 of the License, or
  14 (at your option) any later version.
  15
  16 This program is distributed in the hope that it will be useful, but
  17 WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with this program; if not, write to the Free Software
  23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 -}
  27
  28 module Ganeti.Monitoring.Server
  29   ( main
  30   , checkMain
  31   , prepMain
  32   ) where
  33
  34 import Control.Applicative
  35 import Control.Monad
  36 import Control.Monad.IO.Class
  37 import Data.ByteString.Char8 hiding (map, filter, find)
  38 import Data.List
  39 import Snap.Core
  40 import Snap.Http.Server
  41 import qualified Text.JSON as J
  42
  43 import qualified Ganeti.BasicTypes as BT
  44 import Ganeti.Daemon
  45 import qualified Ganeti.DataCollectors.Drbd as Drbd
  46 import Ganeti.DataCollectors.Types
  47 import qualified Ganeti.Constants as C
  48
  49 -- * Types and constants definitions
  50
  51 -- | Type alias for checkMain results.
  52 type CheckResult = ()
  53
  54 -- | Type alias for prepMain results.
  55 type PrepResult = Config Snap ()
  56
  57 -- | Version of the latest supported http API.
  58 latestAPIVersion :: Int
  59 latestAPIVersion = 1
  60
  61 -- | Type describing a data collector basic information
  62 data DataCollector = DataCollector
  63   { dName     :: String           -- ^ Name of the data collector
  64   , dCategory :: Maybe DCCategory -- ^ Category (storage, instance, ecc)
  65                                   --   of the collector
  66   , dKind     :: DCKind           -- ^ Kind (performance or status reporting) of
  67                                   --   the data collector
  68   , dReport   :: IO DCReport      -- ^ Report produced by the collector
  69   }
  70
  71 -- | The list of available builtin data collectors.
  72 collectors :: [DataCollector]
  73 collectors =
  74   [ DataCollector Drbd.dcName Drbd.dcCategory Drbd.dcKind Drbd.dcReport
  75   ]
  76
  77 -- * Configuration handling
  78
  79 -- | The default configuration for the HTTP server.
  80 defaultHttpConf :: Config Snap ()
  81 defaultHttpConf =
  82   setAccessLog (ConfigFileLog C.daemonsExtraLogfilesGanetiMondAccess) .
  83   setCompression False .
  84   setErrorLog (ConfigFileLog C.daemonsExtraLogfilesGanetiMondError) $
  85   setVerbose False
  86   emptyConfig
  87
  88 -- * Helper functions
  89
  90 -- | Check function for the monitoring agent.
  91 checkMain :: CheckFn CheckResult
  92 checkMain _ = return $ Right ()
  93
  94 -- | Prepare function for monitoring agent.
  95 prepMain :: PrepFn CheckResult PrepResult
  96 prepMain opts _ =
  97   return $
  98     setPort (maybe C.defaultMondPort fromIntegral (optPort opts))
  99       defaultHttpConf
 100
 101 -- * Query answers
 102
 103 -- | Reply to the supported API version numbers query.
 104 versionQ :: Snap ()
 105 versionQ = writeBS . pack $ J.encode [latestAPIVersion]
 106
 107 -- | Version 1 of the monitoring HTTP API.
 108 version1Api :: Snap ()
 109 version1Api =
 110   let returnNull = writeBS . pack $ J.encode J.JSNull :: Snap ()
 111   in ifTop returnNull <|>
 112      route
 113        [ ("list", listHandler)
 114        , ("report", reportHandler)
 115        ]
 116
 117 -- | Get the JSON representation of a data collector to be used in the collector
 118 -- list.
 119 dcListItem :: DataCollector -> J.JSValue
 120 dcListItem dc =
 121   J.JSArray
 122     [ J.showJSON $ dName dc
 123     , maybe J.JSNull J.showJSON $ dCategory dc
 124     , J.showJSON $ dKind dc
 125     ]
 126
 127 -- | Handler for returning lists.
 128 listHandler :: Snap ()
 129 listHandler =
 130   dir "collectors" . writeBS . pack . J.encode $ map dcListItem collectors
 131
 132 -- | Handler for returning data collector reports.
 133 reportHandler :: Snap ()
 134 reportHandler =
 135   route
 136     [ ("all", allReports)
 137     , (":category/:collector", oneReport)
 138     ]
 139
 140 -- | Return the report of all the available collectors.
 141 allReports :: Snap ()
 142 allReports = do
 143   reports <- mapM (liftIO . dReport) collectors
 144   writeBS . pack . J.encode $ reports
 145
 146 -- | Returns a category given its name.
 147 -- If "collector" is given as the name, the collector has no category, and
 148 -- Nothing will be returned.
 149 catFromName :: String -> BT.Result (Maybe DCCategory)
 150 catFromName "instance"   = BT.Ok $ Just DCInstance
 151 catFromName "storage"    = BT.Ok $ Just DCStorage
 152 catFromName "daemon"     = BT.Ok $ Just DCDaemon
 153 catFromName "hypervisor" = BT.Ok $ Just DCHypervisor
 154 catFromName "default"    = BT.Ok Nothing
 155 catFromName _            = BT.Bad "No such category"
 156
 157 -- | Return the report of one collector
 158 oneReport :: Snap ()
 159 oneReport = do
 160   categoryName <- fmap (maybe mzero unpack) $ getParam "category"
 161   collectorName <- fmap (maybe mzero unpack) $ getParam "collector"
 162   category <-
 163     case catFromName categoryName of
 164       BT.Ok cat -> return cat
 165       BT.Bad msg -> fail msg
 166   collector <-
 167     case
 168       find (\col -> collectorName == dName col) $
 169         filter (\c -> category == dCategory c) collectors of
 170       Just col -> return col
 171       Nothing -> fail "Unable to find the requested collector"
 172   report <- liftIO $ dReport collector
 173   writeBS . pack . J.encode $ report
 174
 175 -- | The function implementing the HTTP API of the monitoring agent.
 176 -- TODO: Currently it only replies to the API version query: implement all the
 177 -- missing features.
 178 monitoringApi :: Snap ()
 179 monitoringApi =
 180   ifTop versionQ <|>
 181   dir "1" version1Api
 182
 183 -- | Main function.
 184 main :: MainFn CheckResult PrepResult
 185 main _ _ httpConf =
 186   httpServe httpConf $ method GET monitoringApi