root / htools / Ganeti / Rpc.hs @ 1496f5f3
History | View | Annotate | Download (15.1 kB)
1 | eaed5f19 | Agata Murawska | {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, CPP, |
---|---|---|---|
2 | 96dad12d | Agata Murawska | BangPatterns, TemplateHaskell #-} |
3 | d4709cce | Agata Murawska | |
4 | d4709cce | Agata Murawska | {-| Implementation of the RPC client. |
5 | d4709cce | Agata Murawska | |
6 | d4709cce | Agata Murawska | -} |
7 | d4709cce | Agata Murawska | |
8 | d4709cce | Agata Murawska | {- |
9 | d4709cce | Agata Murawska | |
10 | d4709cce | Agata Murawska | Copyright (C) 2012 Google Inc. |
11 | d4709cce | Agata Murawska | |
12 | d4709cce | Agata Murawska | This program is free software; you can redistribute it and/or modify |
13 | d4709cce | Agata Murawska | it under the terms of the GNU General Public License as published by |
14 | d4709cce | Agata Murawska | the Free Software Foundation; either version 2 of the License, or |
15 | d4709cce | Agata Murawska | (at your option) any later version. |
16 | d4709cce | Agata Murawska | |
17 | d4709cce | Agata Murawska | This program is distributed in the hope that it will be useful, but |
18 | d4709cce | Agata Murawska | WITHOUT ANY WARRANTY; without even the implied warranty of |
19 | d4709cce | Agata Murawska | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
20 | d4709cce | Agata Murawska | General Public License for more details. |
21 | d4709cce | Agata Murawska | |
22 | d4709cce | Agata Murawska | You should have received a copy of the GNU General Public License |
23 | d4709cce | Agata Murawska | along with this program; if not, write to the Free Software |
24 | d4709cce | Agata Murawska | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
25 | d4709cce | Agata Murawska | 02110-1301, USA. |
26 | d4709cce | Agata Murawska | |
27 | d4709cce | Agata Murawska | -} |
28 | d4709cce | Agata Murawska | |
29 | d4709cce | Agata Murawska | module Ganeti.Rpc |
30 | d4709cce | Agata Murawska | ( RpcCall |
31 | d4709cce | Agata Murawska | , Rpc |
32 | d4709cce | Agata Murawska | , RpcError(..) |
33 | 599239ad | Agata Murawska | , ERpcError |
34 | 60443f61 | Agata Murawska | , explainRpcError |
35 | eaed5f19 | Agata Murawska | , executeRpcCall |
36 | d4709cce | Agata Murawska | |
37 | d4709cce | Agata Murawska | , rpcCallName |
38 | d4709cce | Agata Murawska | , rpcCallTimeout |
39 | d4709cce | Agata Murawska | , rpcCallData |
40 | d4709cce | Agata Murawska | , rpcCallAcceptOffline |
41 | d4709cce | Agata Murawska | |
42 | d4709cce | Agata Murawska | , rpcResultFill |
43 | 96dad12d | Agata Murawska | |
44 | 96dad12d | Agata Murawska | , InstanceInfo(..) |
45 | 5188fdb7 | Agata Murawska | , RpcCallInstanceInfo(..) |
46 | 5188fdb7 | Agata Murawska | , RpcResultInstanceInfo(..) |
47 | 5188fdb7 | Agata Murawska | |
48 | 96dad12d | Agata Murawska | , RpcCallAllInstancesInfo(..) |
49 | 96dad12d | Agata Murawska | , RpcResultAllInstancesInfo(..) |
50 | 96dad12d | Agata Murawska | |
51 | c1c5aab1 | Agata Murawska | , RpcCallInstanceList(..) |
52 | c1c5aab1 | Agata Murawska | , RpcResultInstanceList(..) |
53 | c1c5aab1 | Agata Murawska | |
54 | dc623a95 | Agata Murawska | , HvInfo(..) |
55 | dc623a95 | Agata Murawska | , VgInfo(..) |
56 | dc623a95 | Agata Murawska | , RpcCallNodeInfo(..) |
57 | dc623a95 | Agata Murawska | , RpcResultNodeInfo(..) |
58 | dc623a95 | Agata Murawska | |
59 | 8779d21a | Agata Murawska | , RpcCallVersion(..) |
60 | 8779d21a | Agata Murawska | , RpcResultVersion(..) |
61 | 8779d21a | Agata Murawska | |
62 | 47163f0f | Agata Murawska | , StorageField(..) |
63 | 47163f0f | Agata Murawska | , RpcCallStorageList(..) |
64 | 47163f0f | Agata Murawska | , RpcResultStorageList(..) |
65 | 47163f0f | Agata Murawska | |
66 | de2a5704 | Iustin Pop | , RpcCallTestDelay(..) |
67 | de2a5704 | Iustin Pop | , RpcResultTestDelay(..) |
68 | de2a5704 | Iustin Pop | |
69 | 96dad12d | Agata Murawska | , rpcTimeoutFromRaw -- FIXME: Not used anywhere |
70 | d4709cce | Agata Murawska | ) where |
71 | d4709cce | Agata Murawska | |
72 | 9b09c0be | Agata Murawska | import Control.Arrow (second) |
73 | d4709cce | Agata Murawska | import qualified Text.JSON as J |
74 | 9b09c0be | Agata Murawska | import Text.JSON.Pretty (pp_value) |
75 | d4709cce | Agata Murawska | |
76 | eaed5f19 | Agata Murawska | #ifndef NO_CURL |
77 | eaed5f19 | Agata Murawska | import Network.Curl |
78 | 7766de33 | Agata Murawska | import qualified Ganeti.Path as P |
79 | eaed5f19 | Agata Murawska | #endif |
80 | eaed5f19 | Agata Murawska | |
81 | eaed5f19 | Agata Murawska | import qualified Ganeti.Constants as C |
82 | d4709cce | Agata Murawska | import Ganeti.Objects |
83 | 96dad12d | Agata Murawska | import Ganeti.THH |
84 | 22381768 | Iustin Pop | import Ganeti.Types |
85 | f3baf5ef | Iustin Pop | import Ganeti.Compat |
86 | eaed5f19 | Agata Murawska | |
87 | de2a5704 | Iustin Pop | -- * Base RPC functionality and types |
88 | de2a5704 | Iustin Pop | |
89 | eaed5f19 | Agata Murawska | #ifndef NO_CURL |
90 | eaed5f19 | Agata Murawska | -- | The curl options used for RPC. |
91 | eaed5f19 | Agata Murawska | curlOpts :: [CurlOption] |
92 | eaed5f19 | Agata Murawska | curlOpts = [ CurlFollowLocation False |
93 | eaed5f19 | Agata Murawska | , CurlSSLVerifyHost 0 |
94 | eaed5f19 | Agata Murawska | , CurlSSLVerifyPeer True |
95 | eaed5f19 | Agata Murawska | , CurlSSLCertType "PEM" |
96 | eaed5f19 | Agata Murawska | , CurlSSLKeyType "PEM" |
97 | eaed5f19 | Agata Murawska | , CurlConnectTimeout (fromIntegral C.rpcConnectTimeout) |
98 | eaed5f19 | Agata Murawska | ] |
99 | eaed5f19 | Agata Murawska | #endif |
100 | d4709cce | Agata Murawska | |
101 | d4709cce | Agata Murawska | -- | Data type for RPC error reporting. |
102 | d4709cce | Agata Murawska | data RpcError |
103 | d4709cce | Agata Murawska | = CurlDisabledError |
104 | d4709cce | Agata Murawska | | CurlLayerError Node String |
105 | d4709cce | Agata Murawska | | JsonDecodeError String |
106 | 6fddde87 | Agata Murawska | | RpcResultError String |
107 | d4709cce | Agata Murawska | | OfflineNodeError Node |
108 | 60443f61 | Agata Murawska | deriving (Show, Eq) |
109 | d4709cce | Agata Murawska | |
110 | 60443f61 | Agata Murawska | -- | Provide explanation to RPC errors. |
111 | 60443f61 | Agata Murawska | explainRpcError :: RpcError -> String |
112 | 60443f61 | Agata Murawska | explainRpcError CurlDisabledError = |
113 | d4709cce | Agata Murawska | "RPC/curl backend disabled at compile time" |
114 | 60443f61 | Agata Murawska | explainRpcError (CurlLayerError node code) = |
115 | 6fddde87 | Agata Murawska | "Curl error for " ++ nodeName node ++ ", " ++ code |
116 | 60443f61 | Agata Murawska | explainRpcError (JsonDecodeError msg) = |
117 | 6fddde87 | Agata Murawska | "Error while decoding JSON from HTTP response: " ++ msg |
118 | 60443f61 | Agata Murawska | explainRpcError (RpcResultError msg) = |
119 | 6fddde87 | Agata Murawska | "Error reponse received from RPC server: " ++ msg |
120 | 60443f61 | Agata Murawska | explainRpcError (OfflineNodeError node) = |
121 | d4709cce | Agata Murawska | "Node " ++ nodeName node ++ " is marked as offline" |
122 | d4709cce | Agata Murawska | |
123 | 599239ad | Agata Murawska | type ERpcError = Either RpcError |
124 | 599239ad | Agata Murawska | |
125 | 96dad12d | Agata Murawska | -- | Basic timeouts for RPC calls. |
126 | 96dad12d | Agata Murawska | $(declareIADT "RpcTimeout" |
127 | 96dad12d | Agata Murawska | [ ( "Urgent", 'C.rpcTmoUrgent ) |
128 | 96dad12d | Agata Murawska | , ( "Fast", 'C.rpcTmoFast ) |
129 | 96dad12d | Agata Murawska | , ( "Normal", 'C.rpcTmoNormal ) |
130 | 96dad12d | Agata Murawska | , ( "Slow", 'C.rpcTmoSlow ) |
131 | 96dad12d | Agata Murawska | , ( "FourHours", 'C.rpcTmo4hrs ) |
132 | 96dad12d | Agata Murawska | , ( "OneDay", 'C.rpcTmo1day ) |
133 | 96dad12d | Agata Murawska | ]) |
134 | 96dad12d | Agata Murawska | |
135 | d4709cce | Agata Murawska | -- | A generic class for RPC calls. |
136 | d4709cce | Agata Murawska | class (J.JSON a) => RpcCall a where |
137 | d4709cce | Agata Murawska | -- | Give the (Python) name of the procedure. |
138 | d4709cce | Agata Murawska | rpcCallName :: a -> String |
139 | d4709cce | Agata Murawska | -- | Calculate the timeout value for the call execution. |
140 | d4709cce | Agata Murawska | rpcCallTimeout :: a -> Int |
141 | d4709cce | Agata Murawska | -- | Prepare arguments of the call to be send as POST. |
142 | d4709cce | Agata Murawska | rpcCallData :: Node -> a -> String |
143 | d4709cce | Agata Murawska | -- | Whether we accept offline nodes when making a call. |
144 | d4709cce | Agata Murawska | rpcCallAcceptOffline :: a -> Bool |
145 | d4709cce | Agata Murawska | |
146 | d4709cce | Agata Murawska | -- | Generic class that ensures matching RPC call with its respective |
147 | d4709cce | Agata Murawska | -- result. |
148 | 47163f0f | Agata Murawska | class (RpcCall a, J.JSON b) => Rpc a b | a -> b, b -> a where |
149 | 47163f0f | Agata Murawska | -- | Create a result based on the received HTTP response. |
150 | a93b711b | Agata Murawska | rpcResultFill :: a -> J.JSValue -> ERpcError b |
151 | eaed5f19 | Agata Murawska | |
152 | eaed5f19 | Agata Murawska | -- | Http Request definition. |
153 | eaed5f19 | Agata Murawska | data HttpClientRequest = HttpClientRequest |
154 | eaed5f19 | Agata Murawska | { requestTimeout :: Int |
155 | eaed5f19 | Agata Murawska | , requestUrl :: String |
156 | eaed5f19 | Agata Murawska | , requestPostData :: String |
157 | eaed5f19 | Agata Murawska | } |
158 | eaed5f19 | Agata Murawska | |
159 | eaed5f19 | Agata Murawska | -- | Execute the request and return the result as a plain String. When |
160 | eaed5f19 | Agata Murawska | -- curl reports an error, we propagate it. |
161 | 599239ad | Agata Murawska | executeHttpRequest :: Node -> ERpcError HttpClientRequest |
162 | 599239ad | Agata Murawska | -> IO (ERpcError String) |
163 | eaed5f19 | Agata Murawska | |
164 | eaed5f19 | Agata Murawska | executeHttpRequest _ (Left rpc_err) = return $ Left rpc_err |
165 | eaed5f19 | Agata Murawska | #ifdef NO_CURL |
166 | eaed5f19 | Agata Murawska | executeHttpRequest _ _ = return $ Left CurlDisabledError |
167 | eaed5f19 | Agata Murawska | #else |
168 | eaed5f19 | Agata Murawska | executeHttpRequest node (Right request) = do |
169 | 29a30533 | Iustin Pop | cert_file <- P.nodedCertFile |
170 | eaed5f19 | Agata Murawska | let reqOpts = [ CurlTimeout (fromIntegral $ requestTimeout request) |
171 | eaed5f19 | Agata Murawska | , CurlPostFields [requestPostData request] |
172 | 29a30533 | Iustin Pop | , CurlSSLCert cert_file |
173 | 29a30533 | Iustin Pop | , CurlSSLKey cert_file |
174 | 29a30533 | Iustin Pop | , CurlCAInfo cert_file |
175 | eaed5f19 | Agata Murawska | ] |
176 | eaed5f19 | Agata Murawska | url = requestUrl request |
177 | eaed5f19 | Agata Murawska | -- FIXME: This is very similar to getUrl in Htools/Rapi.hs |
178 | eaed5f19 | Agata Murawska | (code, !body) <- curlGetString url $ curlOpts ++ reqOpts |
179 | 2cdaf225 | Iustin Pop | return $ case code of |
180 | 2cdaf225 | Iustin Pop | CurlOK -> Right body |
181 | 2cdaf225 | Iustin Pop | _ -> Left $ CurlLayerError node (show code) |
182 | eaed5f19 | Agata Murawska | #endif |
183 | eaed5f19 | Agata Murawska | |
184 | eaed5f19 | Agata Murawska | -- | Prepare url for the HTTP request. |
185 | eaed5f19 | Agata Murawska | prepareUrl :: (RpcCall a) => Node -> a -> String |
186 | eaed5f19 | Agata Murawska | prepareUrl node call = |
187 | eaed5f19 | Agata Murawska | let node_ip = nodePrimaryIp node |
188 | eaed5f19 | Agata Murawska | port = snd C.daemonsPortsGanetiNoded |
189 | 5b11f8db | Iustin Pop | path_prefix = "https://" ++ node_ip ++ ":" ++ show port |
190 | 5b11f8db | Iustin Pop | in path_prefix ++ "/" ++ rpcCallName call |
191 | eaed5f19 | Agata Murawska | |
192 | eaed5f19 | Agata Murawska | -- | Create HTTP request for a given node provided it is online, |
193 | eaed5f19 | Agata Murawska | -- otherwise create empty response. |
194 | eaed5f19 | Agata Murawska | prepareHttpRequest :: (RpcCall a) => Node -> a |
195 | 599239ad | Agata Murawska | -> ERpcError HttpClientRequest |
196 | eaed5f19 | Agata Murawska | prepareHttpRequest node call |
197 | 5b11f8db | Iustin Pop | | rpcCallAcceptOffline call || not (nodeOffline node) = |
198 | 5b11f8db | Iustin Pop | Right HttpClientRequest { requestTimeout = rpcCallTimeout call |
199 | 5b11f8db | Iustin Pop | , requestUrl = prepareUrl node call |
200 | 5b11f8db | Iustin Pop | , requestPostData = rpcCallData node call |
201 | 5b11f8db | Iustin Pop | } |
202 | eaed5f19 | Agata Murawska | | otherwise = Left $ OfflineNodeError node |
203 | eaed5f19 | Agata Murawska | |
204 | 9b09c0be | Agata Murawska | -- | Parse a result based on the received HTTP response. |
205 | 0ae9ddc4 | Agata Murawska | parseHttpResponse :: (Rpc a b) => a -> ERpcError String -> ERpcError b |
206 | 0ae9ddc4 | Agata Murawska | parseHttpResponse _ (Left err) = Left err |
207 | 0ae9ddc4 | Agata Murawska | parseHttpResponse call (Right res) = |
208 | a93b711b | Agata Murawska | case J.decode res of |
209 | a93b711b | Agata Murawska | J.Error val -> Left $ JsonDecodeError val |
210 | a93b711b | Agata Murawska | J.Ok (True, res'') -> rpcResultFill call res'' |
211 | a93b711b | Agata Murawska | J.Ok (False, jerr) -> case jerr of |
212 | a93b711b | Agata Murawska | J.JSString msg -> Left $ RpcResultError (J.fromJSString msg) |
213 | a93b711b | Agata Murawska | _ -> Left . JsonDecodeError $ show (pp_value jerr) |
214 | 9b09c0be | Agata Murawska | |
215 | eaed5f19 | Agata Murawska | -- | Execute RPC call for a sigle node. |
216 | 599239ad | Agata Murawska | executeSingleRpcCall :: (Rpc a b) => Node -> a -> IO (Node, ERpcError b) |
217 | eaed5f19 | Agata Murawska | executeSingleRpcCall node call = do |
218 | eaed5f19 | Agata Murawska | let request = prepareHttpRequest node call |
219 | eaed5f19 | Agata Murawska | response <- executeHttpRequest node request |
220 | a93b711b | Agata Murawska | let result = parseHttpResponse call response |
221 | eaed5f19 | Agata Murawska | return (node, result) |
222 | eaed5f19 | Agata Murawska | |
223 | eaed5f19 | Agata Murawska | -- | Execute RPC call for many nodes in parallel. |
224 | 599239ad | Agata Murawska | executeRpcCall :: (Rpc a b) => [Node] -> a -> IO [(Node, ERpcError b)] |
225 | eaed5f19 | Agata Murawska | executeRpcCall nodes call = |
226 | eaed5f19 | Agata Murawska | sequence $ parMap rwhnf (uncurry executeSingleRpcCall) |
227 | eaed5f19 | Agata Murawska | (zip nodes $ repeat call) |
228 | 96dad12d | Agata Murawska | |
229 | 9b09c0be | Agata Murawska | -- | Helper function that is used to read dictionaries of values. |
230 | 9b09c0be | Agata Murawska | sanitizeDictResults :: [(String, J.Result a)] -> ERpcError [(String, a)] |
231 | 3d3f562b | Agata Murawska | sanitizeDictResults = |
232 | 3d3f562b | Agata Murawska | foldr sanitize1 (Right []) |
233 | 3d3f562b | Agata Murawska | where |
234 | 3d3f562b | Agata Murawska | sanitize1 _ (Left e) = Left e |
235 | 3d3f562b | Agata Murawska | sanitize1 (_, J.Error e) _ = Left $ JsonDecodeError e |
236 | 3d3f562b | Agata Murawska | sanitize1 (name, J.Ok v) (Right res) = Right $ (name, v) : res |
237 | 9b09c0be | Agata Murawska | |
238 | 7328a28c | Agata Murawska | -- | Helper function to tranform JSON Result to Either RpcError b. |
239 | 7328a28c | Agata Murawska | -- Note: For now we really only use it for b s.t. Rpc c b for some c |
240 | 7328a28c | Agata Murawska | fromJResultToRes :: J.Result a -> (a -> b) -> ERpcError b |
241 | 7328a28c | Agata Murawska | fromJResultToRes (J.Error v) _ = Left $ JsonDecodeError v |
242 | 7328a28c | Agata Murawska | fromJResultToRes (J.Ok v) f = Right $ f v |
243 | 7328a28c | Agata Murawska | |
244 | 7328a28c | Agata Murawska | -- | Helper function transforming JSValue to Rpc result type. |
245 | 7328a28c | Agata Murawska | fromJSValueToRes :: (J.JSON a) => J.JSValue -> (a -> b) -> ERpcError b |
246 | 7328a28c | Agata Murawska | fromJSValueToRes val = fromJResultToRes (J.readJSON val) |
247 | 7328a28c | Agata Murawska | |
248 | 96dad12d | Agata Murawska | -- * RPC calls and results |
249 | 96dad12d | Agata Murawska | |
250 | de2a5704 | Iustin Pop | -- ** Instance info |
251 | de2a5704 | Iustin Pop | |
252 | 5188fdb7 | Agata Murawska | -- | InstanceInfo |
253 | 5188fdb7 | Agata Murawska | -- Returns information about a single instance. |
254 | 5188fdb7 | Agata Murawska | |
255 | 5188fdb7 | Agata Murawska | $(buildObject "RpcCallInstanceInfo" "rpcCallInstInfo" |
256 | 5188fdb7 | Agata Murawska | [ simpleField "instance" [t| String |] |
257 | 5188fdb7 | Agata Murawska | , simpleField "hname" [t| Hypervisor |] |
258 | 5188fdb7 | Agata Murawska | ]) |
259 | 96dad12d | Agata Murawska | |
260 | 5b11f8db | Iustin Pop | $(buildObject "InstanceInfo" "instInfo" |
261 | 9b09c0be | Agata Murawska | [ simpleField "memory" [t| Int|] |
262 | 9b09c0be | Agata Murawska | , simpleField "state" [t| String |] -- It depends on hypervisor :( |
263 | 96dad12d | Agata Murawska | , simpleField "vcpus" [t| Int |] |
264 | 96dad12d | Agata Murawska | , simpleField "time" [t| Int |] |
265 | 96dad12d | Agata Murawska | ]) |
266 | 96dad12d | Agata Murawska | |
267 | 5188fdb7 | Agata Murawska | -- This is optional here because the result may be empty if instance is |
268 | 5188fdb7 | Agata Murawska | -- not on a node - and this is not considered an error. |
269 | 5188fdb7 | Agata Murawska | $(buildObject "RpcResultInstanceInfo" "rpcResInstInfo" |
270 | 5188fdb7 | Agata Murawska | [ optionalField $ simpleField "inst_info" [t| InstanceInfo |]]) |
271 | 5188fdb7 | Agata Murawska | |
272 | 5188fdb7 | Agata Murawska | instance RpcCall RpcCallInstanceInfo where |
273 | 274366e5 | Agata Murawska | rpcCallName _ = "instance_info" |
274 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
275 | 5188fdb7 | Agata Murawska | rpcCallAcceptOffline _ = False |
276 | 274366e5 | Agata Murawska | rpcCallData _ call = J.encode |
277 | 5188fdb7 | Agata Murawska | ( rpcCallInstInfoInstance call |
278 | 5188fdb7 | Agata Murawska | , rpcCallInstInfoHname call |
279 | 5188fdb7 | Agata Murawska | ) |
280 | 5188fdb7 | Agata Murawska | |
281 | 5188fdb7 | Agata Murawska | instance Rpc RpcCallInstanceInfo RpcResultInstanceInfo where |
282 | 5188fdb7 | Agata Murawska | rpcResultFill _ res = |
283 | a93b711b | Agata Murawska | case res of |
284 | 5188fdb7 | Agata Murawska | J.JSObject res' -> |
285 | 5188fdb7 | Agata Murawska | case J.fromJSObject res' of |
286 | 5188fdb7 | Agata Murawska | [] -> Right $ RpcResultInstanceInfo Nothing |
287 | 7328a28c | Agata Murawska | _ -> fromJSValueToRes res (RpcResultInstanceInfo . Just) |
288 | 5188fdb7 | Agata Murawska | _ -> Left $ JsonDecodeError |
289 | 70c2362e | Agata Murawska | ("Expected JSObject, got " ++ show (pp_value res)) |
290 | 5188fdb7 | Agata Murawska | |
291 | de2a5704 | Iustin Pop | -- ** AllInstancesInfo |
292 | de2a5704 | Iustin Pop | |
293 | 5188fdb7 | Agata Murawska | -- | AllInstancesInfo |
294 | 5188fdb7 | Agata Murawska | -- Returns information about all running instances on the given nodes |
295 | 5188fdb7 | Agata Murawska | $(buildObject "RpcCallAllInstancesInfo" "rpcCallAllInstInfo" |
296 | 5188fdb7 | Agata Murawska | [ simpleField "hypervisors" [t| [Hypervisor] |] ]) |
297 | 5188fdb7 | Agata Murawska | |
298 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultAllInstancesInfo" "rpcResAllInstInfo" |
299 | 9b09c0be | Agata Murawska | [ simpleField "instances" [t| [(String, InstanceInfo)] |] ]) |
300 | 96dad12d | Agata Murawska | |
301 | 96dad12d | Agata Murawska | instance RpcCall RpcCallAllInstancesInfo where |
302 | 274366e5 | Agata Murawska | rpcCallName _ = "all_instances_info" |
303 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
304 | 96dad12d | Agata Murawska | rpcCallAcceptOffline _ = False |
305 | 274366e5 | Agata Murawska | rpcCallData _ call = J.encode [rpcCallAllInstInfoHypervisors call] |
306 | 9b09c0be | Agata Murawska | |
307 | 47163f0f | Agata Murawska | instance Rpc RpcCallAllInstancesInfo RpcResultAllInstancesInfo where |
308 | 9b09c0be | Agata Murawska | -- FIXME: Is there a simpler way to do it? |
309 | 47163f0f | Agata Murawska | rpcResultFill _ res = |
310 | a93b711b | Agata Murawska | case res of |
311 | a93b711b | Agata Murawska | J.JSObject res' -> |
312 | 9b09c0be | Agata Murawska | let res'' = map (second J.readJSON) (J.fromJSObject res') |
313 | a93b711b | Agata Murawska | :: [(String, J.Result InstanceInfo)] in |
314 | 9b09c0be | Agata Murawska | case sanitizeDictResults res'' of |
315 | 9b09c0be | Agata Murawska | Left err -> Left err |
316 | 9b09c0be | Agata Murawska | Right insts -> Right $ RpcResultAllInstancesInfo insts |
317 | 9b09c0be | Agata Murawska | _ -> Left $ JsonDecodeError |
318 | 70c2362e | Agata Murawska | ("Expected JSObject, got " ++ show (pp_value res)) |
319 | 96dad12d | Agata Murawska | |
320 | de2a5704 | Iustin Pop | -- ** InstanceList |
321 | de2a5704 | Iustin Pop | |
322 | c1c5aab1 | Agata Murawska | -- | InstanceList |
323 | c1c5aab1 | Agata Murawska | -- Returns the list of running instances on the given nodes. |
324 | 5b11f8db | Iustin Pop | $(buildObject "RpcCallInstanceList" "rpcCallInstList" |
325 | c1c5aab1 | Agata Murawska | [ simpleField "hypervisors" [t| [Hypervisor] |] ]) |
326 | c1c5aab1 | Agata Murawska | |
327 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultInstanceList" "rpcResInstList" |
328 | 9b09c0be | Agata Murawska | [ simpleField "instances" [t| [String] |] ]) |
329 | c1c5aab1 | Agata Murawska | |
330 | c1c5aab1 | Agata Murawska | instance RpcCall RpcCallInstanceList where |
331 | 274366e5 | Agata Murawska | rpcCallName _ = "instance_list" |
332 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
333 | c1c5aab1 | Agata Murawska | rpcCallAcceptOffline _ = False |
334 | 274366e5 | Agata Murawska | rpcCallData _ call = J.encode [rpcCallInstListHypervisors call] |
335 | c1c5aab1 | Agata Murawska | |
336 | 47163f0f | Agata Murawska | instance Rpc RpcCallInstanceList RpcResultInstanceList where |
337 | 7328a28c | Agata Murawska | rpcResultFill _ res = fromJSValueToRes res RpcResultInstanceList |
338 | c1c5aab1 | Agata Murawska | |
339 | de2a5704 | Iustin Pop | -- ** NodeInfo |
340 | de2a5704 | Iustin Pop | |
341 | dc623a95 | Agata Murawska | -- | NodeInfo |
342 | dc623a95 | Agata Murawska | -- Return node information. |
343 | 5b11f8db | Iustin Pop | $(buildObject "RpcCallNodeInfo" "rpcCallNodeInfo" |
344 | 9b09c0be | Agata Murawska | [ simpleField "volume_groups" [t| [String] |] |
345 | 9b09c0be | Agata Murawska | , simpleField "hypervisors" [t| [Hypervisor] |] |
346 | dc623a95 | Agata Murawska | ]) |
347 | dc623a95 | Agata Murawska | |
348 | 5b11f8db | Iustin Pop | $(buildObject "VgInfo" "vgInfo" |
349 | dc623a95 | Agata Murawska | [ simpleField "name" [t| String |] |
350 | 9b09c0be | Agata Murawska | , optionalField $ simpleField "vg_free" [t| Int |] |
351 | 9b09c0be | Agata Murawska | , optionalField $ simpleField "vg_size" [t| Int |] |
352 | dc623a95 | Agata Murawska | ]) |
353 | dc623a95 | Agata Murawska | |
354 | dc623a95 | Agata Murawska | -- | We only provide common fields as described in hv_base.py. |
355 | 5b11f8db | Iustin Pop | $(buildObject "HvInfo" "hvInfo" |
356 | dc623a95 | Agata Murawska | [ simpleField "memory_total" [t| Int |] |
357 | dc623a95 | Agata Murawska | , simpleField "memory_free" [t| Int |] |
358 | dc623a95 | Agata Murawska | , simpleField "memory_dom0" [t| Int |] |
359 | dc623a95 | Agata Murawska | , simpleField "cpu_total" [t| Int |] |
360 | dc623a95 | Agata Murawska | , simpleField "cpu_nodes" [t| Int |] |
361 | dc623a95 | Agata Murawska | , simpleField "cpu_sockets" [t| Int |] |
362 | dc623a95 | Agata Murawska | ]) |
363 | dc623a95 | Agata Murawska | |
364 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultNodeInfo" "rpcResNodeInfo" |
365 | dc623a95 | Agata Murawska | [ simpleField "boot_id" [t| String |] |
366 | dc623a95 | Agata Murawska | , simpleField "vg_info" [t| [VgInfo] |] |
367 | dc623a95 | Agata Murawska | , simpleField "hv_info" [t| [HvInfo] |] |
368 | dc623a95 | Agata Murawska | ]) |
369 | dc623a95 | Agata Murawska | |
370 | dc623a95 | Agata Murawska | instance RpcCall RpcCallNodeInfo where |
371 | 274366e5 | Agata Murawska | rpcCallName _ = "node_info" |
372 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
373 | dc623a95 | Agata Murawska | rpcCallAcceptOffline _ = False |
374 | 274366e5 | Agata Murawska | rpcCallData _ call = J.encode |
375 | 274366e5 | Agata Murawska | ( rpcCallNodeInfoVolumeGroups call |
376 | 274366e5 | Agata Murawska | , rpcCallNodeInfoHypervisors call |
377 | 274366e5 | Agata Murawska | ) |
378 | 9b09c0be | Agata Murawska | |
379 | 47163f0f | Agata Murawska | instance Rpc RpcCallNodeInfo RpcResultNodeInfo where |
380 | 47163f0f | Agata Murawska | rpcResultFill _ res = |
381 | 7328a28c | Agata Murawska | fromJSValueToRes res (\(b, vg, hv) -> RpcResultNodeInfo b vg hv) |
382 | dc623a95 | Agata Murawska | |
383 | de2a5704 | Iustin Pop | -- ** Version |
384 | de2a5704 | Iustin Pop | |
385 | 8779d21a | Agata Murawska | -- | Version |
386 | 8779d21a | Agata Murawska | -- Query node version. |
387 | 8779d21a | Agata Murawska | -- Note: We can't use THH as it does not know what to do with empty dict |
388 | 8779d21a | Agata Murawska | data RpcCallVersion = RpcCallVersion {} |
389 | 139c0683 | Iustin Pop | deriving (Show, Eq) |
390 | 8779d21a | Agata Murawska | |
391 | 8779d21a | Agata Murawska | instance J.JSON RpcCallVersion where |
392 | 8779d21a | Agata Murawska | showJSON _ = J.JSNull |
393 | 8779d21a | Agata Murawska | readJSON J.JSNull = return RpcCallVersion |
394 | 8779d21a | Agata Murawska | readJSON _ = fail "Unable to read RpcCallVersion" |
395 | 8779d21a | Agata Murawska | |
396 | 8779d21a | Agata Murawska | $(buildObject "RpcResultVersion" "rpcResultVersion" |
397 | 8779d21a | Agata Murawska | [ simpleField "version" [t| Int |] |
398 | 8779d21a | Agata Murawska | ]) |
399 | 8779d21a | Agata Murawska | |
400 | 8779d21a | Agata Murawska | instance RpcCall RpcCallVersion where |
401 | 274366e5 | Agata Murawska | rpcCallName _ = "version" |
402 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
403 | 8779d21a | Agata Murawska | rpcCallAcceptOffline _ = True |
404 | ff8f0049 | Iustin Pop | rpcCallData _ = J.encode |
405 | 8779d21a | Agata Murawska | |
406 | 47163f0f | Agata Murawska | instance Rpc RpcCallVersion RpcResultVersion where |
407 | 7328a28c | Agata Murawska | rpcResultFill _ res = fromJSValueToRes res RpcResultVersion |
408 | 8779d21a | Agata Murawska | |
409 | de2a5704 | Iustin Pop | -- ** StorageList |
410 | de2a5704 | Iustin Pop | |
411 | 47163f0f | Agata Murawska | -- | StorageList |
412 | 47163f0f | Agata Murawska | |
413 | 47163f0f | Agata Murawska | -- FIXME: This may be moved to Objects |
414 | 47163f0f | Agata Murawska | $(declareSADT "StorageField" |
415 | 47163f0f | Agata Murawska | [ ( "SFUsed", 'C.sfUsed) |
416 | 47163f0f | Agata Murawska | , ( "SFName", 'C.sfName) |
417 | 47163f0f | Agata Murawska | , ( "SFAllocatable", 'C.sfAllocatable) |
418 | 47163f0f | Agata Murawska | , ( "SFFree", 'C.sfFree) |
419 | 47163f0f | Agata Murawska | , ( "SFSize", 'C.sfSize) |
420 | 47163f0f | Agata Murawska | ]) |
421 | 47163f0f | Agata Murawska | $(makeJSONInstance ''StorageField) |
422 | 47163f0f | Agata Murawska | |
423 | 47163f0f | Agata Murawska | $(buildObject "RpcCallStorageList" "rpcCallStorageList" |
424 | 47163f0f | Agata Murawska | [ simpleField "su_name" [t| StorageType |] |
425 | 47163f0f | Agata Murawska | , simpleField "su_args" [t| [String] |] |
426 | 47163f0f | Agata Murawska | , simpleField "name" [t| String |] |
427 | 47163f0f | Agata Murawska | , simpleField "fields" [t| [StorageField] |] |
428 | 47163f0f | Agata Murawska | ]) |
429 | 47163f0f | Agata Murawska | |
430 | 47163f0f | Agata Murawska | -- FIXME: The resulting JSValues should have types appropriate for their |
431 | 47163f0f | Agata Murawska | -- StorageField value: Used -> Bool, Name -> String etc |
432 | 47163f0f | Agata Murawska | $(buildObject "RpcResultStorageList" "rpcResStorageList" |
433 | 47163f0f | Agata Murawska | [ simpleField "storage" [t| [[(StorageField, J.JSValue)]] |] ]) |
434 | 47163f0f | Agata Murawska | |
435 | 47163f0f | Agata Murawska | instance RpcCall RpcCallStorageList where |
436 | 274366e5 | Agata Murawska | rpcCallName _ = "storage_list" |
437 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Normal |
438 | 47163f0f | Agata Murawska | rpcCallAcceptOffline _ = False |
439 | 274366e5 | Agata Murawska | rpcCallData _ call = J.encode |
440 | 47163f0f | Agata Murawska | ( rpcCallStorageListSuName call |
441 | 47163f0f | Agata Murawska | , rpcCallStorageListSuArgs call |
442 | 47163f0f | Agata Murawska | , rpcCallStorageListName call |
443 | 47163f0f | Agata Murawska | , rpcCallStorageListFields call |
444 | 47163f0f | Agata Murawska | ) |
445 | 47163f0f | Agata Murawska | |
446 | 47163f0f | Agata Murawska | instance Rpc RpcCallStorageList RpcResultStorageList where |
447 | 47163f0f | Agata Murawska | rpcResultFill call res = |
448 | 47163f0f | Agata Murawska | let sfields = rpcCallStorageListFields call in |
449 | 7328a28c | Agata Murawska | fromJSValueToRes res (RpcResultStorageList . map (zip sfields)) |
450 | de2a5704 | Iustin Pop | |
451 | de2a5704 | Iustin Pop | -- ** TestDelay |
452 | de2a5704 | Iustin Pop | |
453 | de2a5704 | Iustin Pop | |
454 | de2a5704 | Iustin Pop | -- | Call definition for test delay. |
455 | de2a5704 | Iustin Pop | $(buildObject "RpcCallTestDelay" "rpcCallTestDelay" |
456 | de2a5704 | Iustin Pop | [ simpleField "duration" [t| Double |] |
457 | de2a5704 | Iustin Pop | ]) |
458 | de2a5704 | Iustin Pop | |
459 | de2a5704 | Iustin Pop | -- | Result definition for test delay. |
460 | de2a5704 | Iustin Pop | data RpcResultTestDelay = RpcResultTestDelay |
461 | de2a5704 | Iustin Pop | deriving Show |
462 | de2a5704 | Iustin Pop | |
463 | de2a5704 | Iustin Pop | -- | Custom JSON instance for null result. |
464 | de2a5704 | Iustin Pop | instance J.JSON RpcResultTestDelay where |
465 | de2a5704 | Iustin Pop | showJSON _ = J.JSNull |
466 | de2a5704 | Iustin Pop | readJSON J.JSNull = return RpcResultTestDelay |
467 | de2a5704 | Iustin Pop | readJSON _ = fail "Unable to read RpcResultTestDelay" |
468 | de2a5704 | Iustin Pop | |
469 | de2a5704 | Iustin Pop | instance RpcCall RpcCallTestDelay where |
470 | de2a5704 | Iustin Pop | rpcCallName _ = "test_delay" |
471 | de2a5704 | Iustin Pop | rpcCallTimeout = ceiling . (+ 5) . rpcCallTestDelayDuration |
472 | de2a5704 | Iustin Pop | rpcCallAcceptOffline _ = False |
473 | de2a5704 | Iustin Pop | rpcCallData _ call = J.encode [rpcCallTestDelayDuration call] |
474 | de2a5704 | Iustin Pop | |
475 | de2a5704 | Iustin Pop | instance Rpc RpcCallTestDelay RpcResultTestDelay where |
476 | de2a5704 | Iustin Pop | rpcResultFill _ res = fromJSValueToRes res id |