root / htools / Ganeti / HTools / Luxi.hs @ b20cbf06
History | View | Annotate | Download (9.3 kB)
1 | 6583e677 | Iustin Pop | {-| Implementation of the LUXI loader. |
---|---|---|---|
2 | 53ec9022 | Iustin Pop | |
3 | 53ec9022 | Iustin Pop | -} |
4 | 53ec9022 | Iustin Pop | |
5 | 53ec9022 | Iustin Pop | {- |
6 | 53ec9022 | Iustin Pop | |
7 | 39420403 | Iustin Pop | Copyright (C) 2009, 2010, 2011 Google Inc. |
8 | 53ec9022 | Iustin Pop | |
9 | 53ec9022 | Iustin Pop | This program is free software; you can redistribute it and/or modify |
10 | 53ec9022 | Iustin Pop | it under the terms of the GNU General Public License as published by |
11 | 53ec9022 | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
12 | 53ec9022 | Iustin Pop | (at your option) any later version. |
13 | 53ec9022 | Iustin Pop | |
14 | 53ec9022 | Iustin Pop | This program is distributed in the hope that it will be useful, but |
15 | 53ec9022 | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
16 | 53ec9022 | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | 53ec9022 | Iustin Pop | General Public License for more details. |
18 | 53ec9022 | Iustin Pop | |
19 | 53ec9022 | Iustin Pop | You should have received a copy of the GNU General Public License |
20 | 53ec9022 | Iustin Pop | along with this program; if not, write to the Free Software |
21 | 53ec9022 | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 | 53ec9022 | Iustin Pop | 02110-1301, USA. |
23 | 53ec9022 | Iustin Pop | |
24 | 53ec9022 | Iustin Pop | -} |
25 | 53ec9022 | Iustin Pop | |
26 | 53ec9022 | Iustin Pop | module Ganeti.HTools.Luxi |
27 | 53ec9022 | Iustin Pop | ( |
28 | 53ec9022 | Iustin Pop | loadData |
29 | b3f0710c | Iustin Pop | , parseData |
30 | 53ec9022 | Iustin Pop | ) where |
31 | 53ec9022 | Iustin Pop | |
32 | 53ec9022 | Iustin Pop | import qualified Control.Exception as E |
33 | 53ec9022 | Iustin Pop | import Text.JSON.Types |
34 | 39420403 | Iustin Pop | import qualified Text.JSON |
35 | 53ec9022 | Iustin Pop | |
36 | 6583e677 | Iustin Pop | import qualified Ganeti.Luxi as L |
37 | 53ec9022 | Iustin Pop | import Ganeti.HTools.Loader |
38 | 53ec9022 | Iustin Pop | import Ganeti.HTools.Types |
39 | a679e9dc | Iustin Pop | import qualified Ganeti.HTools.Group as Group |
40 | 53ec9022 | Iustin Pop | import qualified Ganeti.HTools.Node as Node |
41 | 53ec9022 | Iustin Pop | import qualified Ganeti.HTools.Instance as Instance |
42 | f5ed8632 | Iustin Pop | import Ganeti.HTools.Utils (fromJVal, annotateResult, tryFromObj, asJSObject) |
43 | 53ec9022 | Iustin Pop | |
44 | 53ec9022 | Iustin Pop | -- * Utility functions |
45 | 53ec9022 | Iustin Pop | |
46 | 53ec9022 | Iustin Pop | -- | Ensure a given JSValue is actually a JSArray. |
47 | 53ec9022 | Iustin Pop | toArray :: (Monad m) => JSValue -> m [JSValue] |
48 | 53ec9022 | Iustin Pop | toArray v = |
49 | 53ec9022 | Iustin Pop | case v of |
50 | 53ec9022 | Iustin Pop | JSArray arr -> return arr |
51 | 53ec9022 | Iustin Pop | o -> fail ("Invalid input, expected array but got " ++ show o) |
52 | 53ec9022 | Iustin Pop | |
53 | 92678b3c | Iustin Pop | -- | Get values behind \"data\" part of the result. |
54 | 92678b3c | Iustin Pop | getData :: (Monad m) => JSValue -> m JSValue |
55 | 92678b3c | Iustin Pop | getData v = |
56 | 92678b3c | Iustin Pop | case v of |
57 | 92678b3c | Iustin Pop | JSObject o -> |
58 | 92678b3c | Iustin Pop | case fromJSObject o of |
59 | 92678b3c | Iustin Pop | [("data", jsdata), ("fields", _)] -> return jsdata |
60 | 92678b3c | Iustin Pop | x -> fail $ "Invalid input, expected two-element list but got " |
61 | 92678b3c | Iustin Pop | ++ show x |
62 | 92678b3c | Iustin Pop | x -> fail ("Invalid input, expected dict entry but got " ++ show x) |
63 | 92678b3c | Iustin Pop | |
64 | 92678b3c | Iustin Pop | -- | Get [(status, value)] list for each element queried. |
65 | 92678b3c | Iustin Pop | toPairs :: (Monad m) => JSValue -> m [[(JSValue, JSValue)]] |
66 | 92678b3c | Iustin Pop | toPairs (JSArray arr) = do |
67 | 92678b3c | Iustin Pop | arr' <- mapM toArray arr -- list of resulting elements |
68 | 92678b3c | Iustin Pop | arr'' <- mapM (mapM toArray) arr' -- list of list of [status, value] |
69 | 92678b3c | Iustin Pop | return $ map (map (\a -> (a!!0, a!!1))) arr'' -- FIXME: hackish |
70 | 92678b3c | Iustin Pop | toPairs o = fail ("Invalid input, expected array but got " ++ show o) |
71 | 92678b3c | Iustin Pop | |
72 | 92678b3c | Iustin Pop | -- | Prepare resulting output as parsers expect it. |
73 | 92678b3c | Iustin Pop | extractArray :: (Monad m) => JSValue -> m [JSValue] |
74 | 92678b3c | Iustin Pop | extractArray v = do |
75 | 92678b3c | Iustin Pop | arr <- getData v >>= toPairs |
76 | 92678b3c | Iustin Pop | return $ map (JSArray. map snd) arr |
77 | 92678b3c | Iustin Pop | |
78 | 39420403 | Iustin Pop | -- | Annotate errors when converting values with owner/attribute for |
79 | 39420403 | Iustin Pop | -- better debugging. |
80 | 39420403 | Iustin Pop | genericConvert :: (Text.JSON.JSON a) => |
81 | 39420403 | Iustin Pop | String -- ^ The object type |
82 | 39420403 | Iustin Pop | -> String -- ^ The object name |
83 | 39420403 | Iustin Pop | -> String -- ^ The attribute we're trying to convert |
84 | 39420403 | Iustin Pop | -> JSValue -- ^ The value we try to convert |
85 | 39420403 | Iustin Pop | -> Result a -- ^ The annotated result |
86 | 39420403 | Iustin Pop | genericConvert otype oname oattr = |
87 | 6a062ff9 | Iustin Pop | annotateResult (otype ++ " '" ++ oname ++ |
88 | 6a062ff9 | Iustin Pop | "', error while reading attribute '" ++ |
89 | 39420403 | Iustin Pop | oattr ++ "'") . fromJVal |
90 | 39420403 | Iustin Pop | |
91 | 53ec9022 | Iustin Pop | -- * Data querying functionality |
92 | 53ec9022 | Iustin Pop | |
93 | 53ec9022 | Iustin Pop | -- | The input data for node query. |
94 | 683b1ca7 | Iustin Pop | queryNodesMsg :: L.LuxiOp |
95 | 53ec9022 | Iustin Pop | queryNodesMsg = |
96 | 92678b3c | Iustin Pop | L.Query L.QRNode ["name", "mtotal", "mnode", "mfree", "dtotal", "dfree", |
97 | 92678b3c | Iustin Pop | "ctotal", "offline", "drained", "vm_capable", |
98 | b20cbf06 | Iustin Pop | "group.uuid"] () |
99 | 53ec9022 | Iustin Pop | |
100 | 53ec9022 | Iustin Pop | -- | The input data for instance query. |
101 | 683b1ca7 | Iustin Pop | queryInstancesMsg :: L.LuxiOp |
102 | 53ec9022 | Iustin Pop | queryInstancesMsg = |
103 | 92678b3c | Iustin Pop | L.Query L.QRInstance ["name", "disk_usage", "be/memory", "be/vcpus", |
104 | 92678b3c | Iustin Pop | "status", "pnode", "snodes", "tags", "oper_ram", |
105 | b20cbf06 | Iustin Pop | "be/auto_balance", "disk_template"] () |
106 | 53ec9022 | Iustin Pop | |
107 | a679e9dc | Iustin Pop | -- | The input data for cluster query. |
108 | 683b1ca7 | Iustin Pop | queryClusterInfoMsg :: L.LuxiOp |
109 | 683b1ca7 | Iustin Pop | queryClusterInfoMsg = L.QueryClusterInfo |
110 | f89235f1 | Iustin Pop | |
111 | a679e9dc | Iustin Pop | -- | The input data for node group query. |
112 | a679e9dc | Iustin Pop | queryGroupsMsg :: L.LuxiOp |
113 | a679e9dc | Iustin Pop | queryGroupsMsg = |
114 | b20cbf06 | Iustin Pop | L.Query L.QRGroup ["uuid", "name", "alloc_policy"] () |
115 | a679e9dc | Iustin Pop | |
116 | 179c0828 | Iustin Pop | -- | Wraper over 'callMethod' doing node query. |
117 | 6583e677 | Iustin Pop | queryNodes :: L.Client -> IO (Result JSValue) |
118 | 683b1ca7 | Iustin Pop | queryNodes = L.callMethod queryNodesMsg |
119 | 53ec9022 | Iustin Pop | |
120 | 179c0828 | Iustin Pop | -- | Wraper over 'callMethod' doing instance query. |
121 | 6583e677 | Iustin Pop | queryInstances :: L.Client -> IO (Result JSValue) |
122 | 683b1ca7 | Iustin Pop | queryInstances = L.callMethod queryInstancesMsg |
123 | 53ec9022 | Iustin Pop | |
124 | 179c0828 | Iustin Pop | -- | Wrapper over 'callMethod' doing cluster information query. |
125 | f89235f1 | Iustin Pop | queryClusterInfo :: L.Client -> IO (Result JSValue) |
126 | 683b1ca7 | Iustin Pop | queryClusterInfo = L.callMethod queryClusterInfoMsg |
127 | f89235f1 | Iustin Pop | |
128 | a679e9dc | Iustin Pop | -- | Wrapper over callMethod doing group query. |
129 | a679e9dc | Iustin Pop | queryGroups :: L.Client -> IO (Result JSValue) |
130 | a679e9dc | Iustin Pop | queryGroups = L.callMethod queryGroupsMsg |
131 | a679e9dc | Iustin Pop | |
132 | 53ec9022 | Iustin Pop | -- | Parse a instance list in JSON format. |
133 | 53ec9022 | Iustin Pop | getInstances :: NameAssoc |
134 | 53ec9022 | Iustin Pop | -> JSValue |
135 | 53ec9022 | Iustin Pop | -> Result [(String, Instance.Instance)] |
136 | 92678b3c | Iustin Pop | getInstances ktn arr = extractArray arr >>= mapM (parseInstance ktn) |
137 | 53ec9022 | Iustin Pop | |
138 | 53ec9022 | Iustin Pop | -- | Construct an instance from a JSON object. |
139 | 6ff78049 | Iustin Pop | parseInstance :: NameAssoc |
140 | 53ec9022 | Iustin Pop | -> JSValue |
141 | 53ec9022 | Iustin Pop | -> Result (String, Instance.Instance) |
142 | 27671a61 | Iustin Pop | parseInstance ktn (JSArray [ name, disk, mem, vcpus |
143 | 6880526c | Iustin Pop | , status, pnode, snodes, tags, oram |
144 | b3c5e8de | Iustin Pop | , auto_balance, disk_template ]) = do |
145 | 117dc2d8 | Iustin Pop | xname <- annotateResult "Parsing new instance" (fromJVal name) |
146 | 39420403 | Iustin Pop | let convert a = genericConvert "Instance" xname a |
147 | 39420403 | Iustin Pop | xdisk <- convert "disk_usage" disk |
148 | 6402a260 | Iustin Pop | xmem <- (case oram of |
149 | 39420403 | Iustin Pop | JSRational _ _ -> convert "oper_ram" oram |
150 | 39420403 | Iustin Pop | _ -> convert "be/memory" mem) |
151 | 39420403 | Iustin Pop | xvcpus <- convert "be/vcpus" vcpus |
152 | 39420403 | Iustin Pop | xpnode <- convert "pnode" pnode >>= lookupNode ktn xname |
153 | 39420403 | Iustin Pop | xsnodes <- convert "snodes" snodes::Result [JSString] |
154 | 53ec9022 | Iustin Pop | snode <- (if null xsnodes then return Node.noSecondary |
155 | 53ec9022 | Iustin Pop | else lookupNode ktn xname (fromJSString $ head xsnodes)) |
156 | 39420403 | Iustin Pop | xrunning <- convert "status" status |
157 | 39420403 | Iustin Pop | xtags <- convert "tags" tags |
158 | 6880526c | Iustin Pop | xauto_balance <- convert "auto_balance" auto_balance |
159 | b3c5e8de | Iustin Pop | xdt <- convert "disk_template" disk_template |
160 | 17e7af2b | Iustin Pop | let inst = Instance.create xname xmem xdisk xvcpus |
161 | b3c5e8de | Iustin Pop | xrunning xtags xauto_balance xpnode snode xdt |
162 | 53ec9022 | Iustin Pop | return (xname, inst) |
163 | 53ec9022 | Iustin Pop | |
164 | 53ec9022 | Iustin Pop | parseInstance _ v = fail ("Invalid instance query result: " ++ show v) |
165 | 53ec9022 | Iustin Pop | |
166 | 53ec9022 | Iustin Pop | -- | Parse a node list in JSON format. |
167 | 10ef6b4e | Iustin Pop | getNodes :: NameAssoc -> JSValue -> Result [(String, Node.Node)] |
168 | 92678b3c | Iustin Pop | getNodes ktg arr = extractArray arr >>= mapM (parseNode ktg) |
169 | 53ec9022 | Iustin Pop | |
170 | 53ec9022 | Iustin Pop | -- | Construct a node from a JSON object. |
171 | 10ef6b4e | Iustin Pop | parseNode :: NameAssoc -> JSValue -> Result (String, Node.Node) |
172 | 10ef6b4e | Iustin Pop | parseNode ktg (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree |
173 | 10ef6b4e | Iustin Pop | , ctotal, offline, drained, vm_capable, g_uuid ]) |
174 | 53ec9022 | Iustin Pop | = do |
175 | 117dc2d8 | Iustin Pop | xname <- annotateResult "Parsing new node" (fromJVal name) |
176 | 39420403 | Iustin Pop | let convert a = genericConvert "Node" xname a |
177 | 39420403 | Iustin Pop | xoffline <- convert "offline" offline |
178 | 39420403 | Iustin Pop | xdrained <- convert "drained" drained |
179 | 39420403 | Iustin Pop | xvm_capable <- convert "vm_capable" vm_capable |
180 | 39420403 | Iustin Pop | xgdx <- convert "group.uuid" g_uuid >>= lookupGroup ktg xname |
181 | 9d775204 | Iustin Pop | node <- (if xoffline || xdrained || not xvm_capable |
182 | 10ef6b4e | Iustin Pop | then return $ Node.create xname 0 0 0 0 0 0 True xgdx |
183 | 53ec9022 | Iustin Pop | else do |
184 | 39420403 | Iustin Pop | xmtotal <- convert "mtotal" mtotal |
185 | 39420403 | Iustin Pop | xmnode <- convert "mnode" mnode |
186 | 39420403 | Iustin Pop | xmfree <- convert "mfree" mfree |
187 | 39420403 | Iustin Pop | xdtotal <- convert "dtotal" dtotal |
188 | 39420403 | Iustin Pop | xdfree <- convert "dfree" dfree |
189 | 39420403 | Iustin Pop | xctotal <- convert "ctotal" ctotal |
190 | 53ec9022 | Iustin Pop | return $ Node.create xname xmtotal xmnode xmfree |
191 | 10ef6b4e | Iustin Pop | xdtotal xdfree xctotal False xgdx) |
192 | 53ec9022 | Iustin Pop | return (xname, node) |
193 | 53ec9022 | Iustin Pop | |
194 | 10ef6b4e | Iustin Pop | parseNode _ v = fail ("Invalid node query result: " ++ show v) |
195 | 53ec9022 | Iustin Pop | |
196 | 179c0828 | Iustin Pop | -- | Parses the cluster tags. |
197 | f89235f1 | Iustin Pop | getClusterTags :: JSValue -> Result [String] |
198 | f89235f1 | Iustin Pop | getClusterTags v = do |
199 | f89235f1 | Iustin Pop | let errmsg = "Parsing cluster info" |
200 | f89235f1 | Iustin Pop | obj <- annotateResult errmsg $ asJSObject v |
201 | 5182e970 | Iustin Pop | tryFromObj errmsg (fromJSObject obj) "tags" |
202 | f89235f1 | Iustin Pop | |
203 | 179c0828 | Iustin Pop | -- | Parses the cluster groups. |
204 | a679e9dc | Iustin Pop | getGroups :: JSValue -> Result [(String, Group.Group)] |
205 | 92678b3c | Iustin Pop | getGroups jsv = extractArray jsv >>= mapM parseGroup |
206 | a679e9dc | Iustin Pop | |
207 | 179c0828 | Iustin Pop | -- | Parses a given group information. |
208 | a679e9dc | Iustin Pop | parseGroup :: JSValue -> Result (String, Group.Group) |
209 | 92678b3c | Iustin Pop | parseGroup (JSArray [uuid, name, apol]) = do |
210 | a679e9dc | Iustin Pop | xname <- annotateResult "Parsing new group" (fromJVal name) |
211 | 39420403 | Iustin Pop | let convert a = genericConvert "Group" xname a |
212 | 39420403 | Iustin Pop | xuuid <- convert "uuid" uuid |
213 | 39420403 | Iustin Pop | xapol <- convert "alloc_policy" apol |
214 | d5072e4c | Iustin Pop | return (xuuid, Group.create xname xuuid xapol) |
215 | a679e9dc | Iustin Pop | |
216 | a679e9dc | Iustin Pop | parseGroup v = fail ("Invalid group query result: " ++ show v) |
217 | a679e9dc | Iustin Pop | |
218 | 53ec9022 | Iustin Pop | -- * Main loader functionality |
219 | 53ec9022 | Iustin Pop | |
220 | 525bfb36 | Iustin Pop | -- | Builds the cluster data by querying a given socket name. |
221 | b3f0710c | Iustin Pop | readData :: String -- ^ Unix socket to use as source |
222 | a679e9dc | Iustin Pop | -> IO (Result JSValue, Result JSValue, Result JSValue, Result JSValue) |
223 | b3f0710c | Iustin Pop | readData master = |
224 | 53ec9022 | Iustin Pop | E.bracket |
225 | 6583e677 | Iustin Pop | (L.getClient master) |
226 | 6583e677 | Iustin Pop | L.closeClient |
227 | 53ec9022 | Iustin Pop | (\s -> do |
228 | 53ec9022 | Iustin Pop | nodes <- queryNodes s |
229 | 53ec9022 | Iustin Pop | instances <- queryInstances s |
230 | f89235f1 | Iustin Pop | cinfo <- queryClusterInfo s |
231 | a679e9dc | Iustin Pop | groups <- queryGroups s |
232 | a679e9dc | Iustin Pop | return (groups, nodes, instances, cinfo) |
233 | 53ec9022 | Iustin Pop | ) |
234 | b3f0710c | Iustin Pop | |
235 | 525bfb36 | Iustin Pop | -- | Converts the output of 'readData' into the internal cluster |
236 | 525bfb36 | Iustin Pop | -- representation. |
237 | a679e9dc | Iustin Pop | parseData :: (Result JSValue, Result JSValue, Result JSValue, Result JSValue) |
238 | f4f6eb0b | Iustin Pop | -> Result ClusterData |
239 | a679e9dc | Iustin Pop | parseData (groups, nodes, instances, cinfo) = do |
240 | a679e9dc | Iustin Pop | group_data <- groups >>= getGroups |
241 | 10ef6b4e | Iustin Pop | let (group_names, group_idx) = assignIndices group_data |
242 | 10ef6b4e | Iustin Pop | node_data <- nodes >>= getNodes group_names |
243 | b3f0710c | Iustin Pop | let (node_names, node_idx) = assignIndices node_data |
244 | b3f0710c | Iustin Pop | inst_data <- instances >>= getInstances node_names |
245 | b3f0710c | Iustin Pop | let (_, inst_idx) = assignIndices inst_data |
246 | b3f0710c | Iustin Pop | ctags <- cinfo >>= getClusterTags |
247 | f4f6eb0b | Iustin Pop | return (ClusterData group_idx node_idx inst_idx ctags) |
248 | b3f0710c | Iustin Pop | |
249 | 525bfb36 | Iustin Pop | -- | Top level function for data loading. |
250 | b3f0710c | Iustin Pop | loadData :: String -- ^ Unix socket to use as source |
251 | f4f6eb0b | Iustin Pop | -> IO (Result ClusterData) |
252 | 2a8e2dc9 | Iustin Pop | loadData = fmap parseData . readData |