9a9af404fe7bd2f7412ebf54254fa99c4642b89c
[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 = 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