root / Ganeti / HTools / Luxi.hs @ f89235f1
History | View | Annotate | Download (6 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 | 53ec9022 | Iustin Pop | Copyright (C) 2009 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 | 53ec9022 | Iustin Pop | ) where |
30 | 53ec9022 | Iustin Pop | |
31 | 53ec9022 | Iustin Pop | import Data.List |
32 | 53ec9022 | Iustin Pop | import qualified Control.Exception as E |
33 | 53ec9022 | Iustin Pop | import Control.Monad |
34 | 53ec9022 | Iustin Pop | import Text.JSON.Types |
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 | 53ec9022 | Iustin Pop | import qualified Ganeti.HTools.Node as Node |
40 | 53ec9022 | Iustin Pop | import qualified Ganeti.HTools.Instance as Instance |
41 | f89235f1 | Iustin Pop | import Ganeti.HTools.Utils (fromJVal, annotateResult, tryFromObj, asJSObject) |
42 | 53ec9022 | Iustin Pop | |
43 | 53ec9022 | Iustin Pop | -- * Utility functions |
44 | 53ec9022 | Iustin Pop | |
45 | 53ec9022 | Iustin Pop | -- | Ensure a given JSValue is actually a JSArray. |
46 | 53ec9022 | Iustin Pop | toArray :: (Monad m) => JSValue -> m [JSValue] |
47 | 53ec9022 | Iustin Pop | toArray v = |
48 | 53ec9022 | Iustin Pop | case v of |
49 | 53ec9022 | Iustin Pop | JSArray arr -> return arr |
50 | 53ec9022 | Iustin Pop | o -> fail ("Invalid input, expected array but got " ++ show o) |
51 | 53ec9022 | Iustin Pop | |
52 | 53ec9022 | Iustin Pop | -- * Data querying functionality |
53 | 53ec9022 | Iustin Pop | |
54 | 53ec9022 | Iustin Pop | -- | The input data for node query. |
55 | 53ec9022 | Iustin Pop | queryNodesMsg :: JSValue |
56 | 53ec9022 | Iustin Pop | queryNodesMsg = |
57 | 53ec9022 | Iustin Pop | let nnames = JSArray [] |
58 | 53ec9022 | Iustin Pop | fnames = ["name", |
59 | 53ec9022 | Iustin Pop | "mtotal", "mnode", "mfree", |
60 | 53ec9022 | Iustin Pop | "dtotal", "dfree", |
61 | 53ec9022 | Iustin Pop | "ctotal", |
62 | 53ec9022 | Iustin Pop | "offline", "drained"] |
63 | 53ec9022 | Iustin Pop | fields = JSArray $ map (JSString . toJSString) fnames |
64 | 53ec9022 | Iustin Pop | use_locking = JSBool False |
65 | 53ec9022 | Iustin Pop | in JSArray [nnames, fields, use_locking] |
66 | 53ec9022 | Iustin Pop | |
67 | 53ec9022 | Iustin Pop | -- | The input data for instance query. |
68 | 53ec9022 | Iustin Pop | queryInstancesMsg :: JSValue |
69 | 53ec9022 | Iustin Pop | queryInstancesMsg = |
70 | 53ec9022 | Iustin Pop | let nnames = JSArray [] |
71 | 53ec9022 | Iustin Pop | fnames = ["name", |
72 | 53ec9022 | Iustin Pop | "disk_usage", "be/memory", "be/vcpus", |
73 | 17e7af2b | Iustin Pop | "status", "pnode", "snodes", "tags"] |
74 | 53ec9022 | Iustin Pop | fields = JSArray $ map (JSString . toJSString) fnames |
75 | 53ec9022 | Iustin Pop | use_locking = JSBool False |
76 | 53ec9022 | Iustin Pop | in JSArray [nnames, fields, use_locking] |
77 | 53ec9022 | Iustin Pop | |
78 | f89235f1 | Iustin Pop | -- | The input data for cluster query |
79 | f89235f1 | Iustin Pop | queryClusterInfoMsg :: JSValue |
80 | f89235f1 | Iustin Pop | queryClusterInfoMsg = JSArray [] |
81 | f89235f1 | Iustin Pop | |
82 | 53ec9022 | Iustin Pop | -- | Wraper over callMethod doing node query. |
83 | 6583e677 | Iustin Pop | queryNodes :: L.Client -> IO (Result JSValue) |
84 | 6583e677 | Iustin Pop | queryNodes = L.callMethod L.QueryNodes queryNodesMsg |
85 | 53ec9022 | Iustin Pop | |
86 | 53ec9022 | Iustin Pop | -- | Wraper over callMethod doing instance query. |
87 | 6583e677 | Iustin Pop | queryInstances :: L.Client -> IO (Result JSValue) |
88 | 6583e677 | Iustin Pop | queryInstances = L.callMethod L.QueryInstances queryInstancesMsg |
89 | 53ec9022 | Iustin Pop | |
90 | f89235f1 | Iustin Pop | queryClusterInfo :: L.Client -> IO (Result JSValue) |
91 | f89235f1 | Iustin Pop | queryClusterInfo = L.callMethod L.QueryClusterInfo queryClusterInfoMsg |
92 | f89235f1 | Iustin Pop | |
93 | 53ec9022 | Iustin Pop | -- | Parse a instance list in JSON format. |
94 | 53ec9022 | Iustin Pop | getInstances :: NameAssoc |
95 | 53ec9022 | Iustin Pop | -> JSValue |
96 | 53ec9022 | Iustin Pop | -> Result [(String, Instance.Instance)] |
97 | 53ec9022 | Iustin Pop | getInstances ktn arr = toArray arr >>= mapM (parseInstance ktn) |
98 | 53ec9022 | Iustin Pop | |
99 | 53ec9022 | Iustin Pop | -- | Construct an instance from a JSON object. |
100 | 53ec9022 | Iustin Pop | parseInstance :: [(String, Ndx)] |
101 | 53ec9022 | Iustin Pop | -> JSValue |
102 | 53ec9022 | Iustin Pop | -> Result (String, Instance.Instance) |
103 | 27671a61 | Iustin Pop | parseInstance ktn (JSArray [ name, disk, mem, vcpus |
104 | 17e7af2b | Iustin Pop | , status, pnode, snodes, tags ]) = do |
105 | 117dc2d8 | Iustin Pop | xname <- annotateResult "Parsing new instance" (fromJVal name) |
106 | 117dc2d8 | Iustin Pop | let convert v = annotateResult ("Instance '" ++ xname ++ "'") (fromJVal v) |
107 | 117dc2d8 | Iustin Pop | xdisk <- convert disk |
108 | 117dc2d8 | Iustin Pop | xmem <- convert mem |
109 | 117dc2d8 | Iustin Pop | xvcpus <- convert vcpus |
110 | 117dc2d8 | Iustin Pop | xpnode <- convert pnode >>= lookupNode ktn xname |
111 | 117dc2d8 | Iustin Pop | xsnodes <- convert snodes::Result [JSString] |
112 | 53ec9022 | Iustin Pop | snode <- (if null xsnodes then return Node.noSecondary |
113 | 53ec9022 | Iustin Pop | else lookupNode ktn xname (fromJSString $ head xsnodes)) |
114 | 117dc2d8 | Iustin Pop | xrunning <- convert status |
115 | 17e7af2b | Iustin Pop | xtags <- convert tags |
116 | 17e7af2b | Iustin Pop | let inst = Instance.create xname xmem xdisk xvcpus |
117 | 17e7af2b | Iustin Pop | xrunning xtags xpnode snode |
118 | 53ec9022 | Iustin Pop | return (xname, inst) |
119 | 53ec9022 | Iustin Pop | |
120 | 53ec9022 | Iustin Pop | parseInstance _ v = fail ("Invalid instance query result: " ++ show v) |
121 | 53ec9022 | Iustin Pop | |
122 | 53ec9022 | Iustin Pop | -- | Parse a node list in JSON format. |
123 | 53ec9022 | Iustin Pop | getNodes :: JSValue -> Result [(String, Node.Node)] |
124 | 53ec9022 | Iustin Pop | getNodes arr = toArray arr >>= mapM parseNode |
125 | 53ec9022 | Iustin Pop | |
126 | 53ec9022 | Iustin Pop | -- | Construct a node from a JSON object. |
127 | 53ec9022 | Iustin Pop | parseNode :: JSValue -> Result (String, Node.Node) |
128 | 27671a61 | Iustin Pop | parseNode (JSArray [ name, mtotal, mnode, mfree, dtotal, dfree |
129 | 27671a61 | Iustin Pop | , ctotal, offline, drained ]) |
130 | 53ec9022 | Iustin Pop | = do |
131 | 117dc2d8 | Iustin Pop | xname <- annotateResult "Parsing new node" (fromJVal name) |
132 | 117dc2d8 | Iustin Pop | let convert v = annotateResult ("Node '" ++ xname ++ "'") (fromJVal v) |
133 | 117dc2d8 | Iustin Pop | xoffline <- convert offline |
134 | 53ec9022 | Iustin Pop | node <- (if xoffline |
135 | 53ec9022 | Iustin Pop | then return $ Node.create xname 0 0 0 0 0 0 True |
136 | 53ec9022 | Iustin Pop | else do |
137 | 117dc2d8 | Iustin Pop | xdrained <- convert drained |
138 | 117dc2d8 | Iustin Pop | xmtotal <- convert mtotal |
139 | 117dc2d8 | Iustin Pop | xmnode <- convert mnode |
140 | 117dc2d8 | Iustin Pop | xmfree <- convert mfree |
141 | 117dc2d8 | Iustin Pop | xdtotal <- convert dtotal |
142 | 117dc2d8 | Iustin Pop | xdfree <- convert dfree |
143 | 117dc2d8 | Iustin Pop | xctotal <- convert ctotal |
144 | 53ec9022 | Iustin Pop | return $ Node.create xname xmtotal xmnode xmfree |
145 | 53ec9022 | Iustin Pop | xdtotal xdfree xctotal (xoffline || xdrained)) |
146 | 53ec9022 | Iustin Pop | return (xname, node) |
147 | 53ec9022 | Iustin Pop | |
148 | 53ec9022 | Iustin Pop | parseNode v = fail ("Invalid node query result: " ++ show v) |
149 | 53ec9022 | Iustin Pop | |
150 | f89235f1 | Iustin Pop | getClusterTags :: JSValue -> Result [String] |
151 | f89235f1 | Iustin Pop | getClusterTags v = do |
152 | f89235f1 | Iustin Pop | let errmsg = "Parsing cluster info" |
153 | f89235f1 | Iustin Pop | obj <- annotateResult errmsg $ asJSObject v |
154 | f89235f1 | Iustin Pop | tags <- tryFromObj errmsg (fromJSObject obj) "tag" |
155 | f89235f1 | Iustin Pop | return tags |
156 | f89235f1 | Iustin Pop | |
157 | 53ec9022 | Iustin Pop | -- * Main loader functionality |
158 | 53ec9022 | Iustin Pop | |
159 | 53ec9022 | Iustin Pop | -- | Builds the cluster data from an URL. |
160 | 53ec9022 | Iustin Pop | loadData :: String -- ^ Unix socket to use as source |
161 | 94e05c32 | Iustin Pop | -> IO (Result (Node.AssocList, Instance.AssocList, [String])) |
162 | 2485487d | Iustin Pop | loadData master = |
163 | 53ec9022 | Iustin Pop | E.bracket |
164 | 6583e677 | Iustin Pop | (L.getClient master) |
165 | 6583e677 | Iustin Pop | L.closeClient |
166 | 53ec9022 | Iustin Pop | (\s -> do |
167 | 53ec9022 | Iustin Pop | nodes <- queryNodes s |
168 | 53ec9022 | Iustin Pop | instances <- queryInstances s |
169 | f89235f1 | Iustin Pop | cinfo <- queryClusterInfo s |
170 | 53ec9022 | Iustin Pop | return $ do -- Result monad |
171 | 53ec9022 | Iustin Pop | node_data <- nodes >>= getNodes |
172 | 53ec9022 | Iustin Pop | let (node_names, node_idx) = assignIndices node_data |
173 | 53ec9022 | Iustin Pop | inst_data <- instances >>= getInstances node_names |
174 | 53ec9022 | Iustin Pop | let (_, inst_idx) = assignIndices inst_data |
175 | f89235f1 | Iustin Pop | ctags <- cinfo >>= getClusterTags |
176 | f89235f1 | Iustin Pop | return (node_idx, inst_idx, ctags) |
177 | 53ec9022 | Iustin Pop | ) |