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 = writeText "TODO: return the reports of all the collectors"
 143
 144 -- | Returns a category given its name.
 145 -- If "collector" is given as the name, the collector has no category, and
 146 -- Nothing will be returned.
 147 catFromName :: String -> BT.Result (Maybe DCCategory)
 148 catFromName "instance"   = BT.Ok $ Just DCInstance
 149 catFromName "storage"    = BT.Ok $ Just DCStorage
 150 catFromName "daemon"     = BT.Ok $ Just DCDaemon
 151 catFromName "hypervisor" = BT.Ok $ Just DCHypervisor
 152 catFromName "default"    = BT.Ok Nothing
 153 catFromName _            = BT.Bad "No such category"
 154
 155 -- | Return the report of one collector
 156 oneReport :: Snap ()
 157 oneReport = do
 158   categoryName <- fmap (maybe mzero unpack) $ getParam "category"
 159   collectorName <- fmap (maybe mzero unpack) $ getParam "collector"
 160   category <-
 161     case catFromName categoryName of
 162       BT.Ok cat -> return cat
 163       BT.Bad msg -> fail msg
 164   collector <-
 165     case
 166       find (\col -> collectorName == dName col) $
 167         filter (\c -> category == dCategory c) collectors of
 168       Just col -> return col
 169       Nothing -> fail "Unable to find the requested collector"
 170   report <- liftIO $ dReport collector
 171   writeBS . pack . J.encode $ report
 172
 173 -- | The function implementing the HTTP API of the monitoring agent.
 174 -- TODO: Currently it only replies to the API version query: implement all the
 175 -- missing features.
 176 monitoringApi :: Snap ()
 177 monitoringApi =
 178   ifTop versionQ <|>
 179   dir "1" version1Api
 180
 181 -- | Main function.
 182 main :: MainFn CheckResult PrepResult
 183 main _ _ httpConf =
 184   httpServe httpConf $ method GET monitoringApi