Produce a report for all the data collectors
[ganeti-github.git] / 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