root / src / Ganeti / Rpc.hs @ ad56f735
History | View | Annotate | Download (18 kB)
1 | 1ca709c1 | Iustin Pop | {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, |
---|---|---|---|
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 | 1ca709c1 | Iustin Pop | Copyright (C) 2012, 2013 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 | ad56f735 | Hrvoje Ribicic | , executeRpcCalls |
37 | a246ce76 | Michele Tartara | , logRpcErrors |
38 | d4709cce | Agata Murawska | |
39 | d4709cce | Agata Murawska | , rpcCallName |
40 | d4709cce | Agata Murawska | , rpcCallTimeout |
41 | d4709cce | Agata Murawska | , rpcCallData |
42 | d4709cce | Agata Murawska | , rpcCallAcceptOffline |
43 | d4709cce | Agata Murawska | |
44 | d4709cce | Agata Murawska | , rpcResultFill |
45 | 96dad12d | Agata Murawska | |
46 | 96dad12d | Agata Murawska | , InstanceInfo(..) |
47 | 5188fdb7 | Agata Murawska | , RpcCallInstanceInfo(..) |
48 | 5188fdb7 | Agata Murawska | , RpcResultInstanceInfo(..) |
49 | 5188fdb7 | Agata Murawska | |
50 | 96dad12d | Agata Murawska | , RpcCallAllInstancesInfo(..) |
51 | 96dad12d | Agata Murawska | , RpcResultAllInstancesInfo(..) |
52 | 96dad12d | Agata Murawska | |
53 | b9e12624 | Hrvoje Ribicic | , InstanceConsoleInfoParams(..) |
54 | b9e12624 | Hrvoje Ribicic | , InstanceConsoleInfo(..) |
55 | b9e12624 | Hrvoje Ribicic | , RpcCallInstanceConsoleInfo(..) |
56 | b9e12624 | Hrvoje Ribicic | , RpcResultInstanceConsoleInfo(..) |
57 | b9e12624 | Hrvoje Ribicic | |
58 | c1c5aab1 | Agata Murawska | , RpcCallInstanceList(..) |
59 | c1c5aab1 | Agata Murawska | , RpcResultInstanceList(..) |
60 | c1c5aab1 | Agata Murawska | |
61 | dc623a95 | Agata Murawska | , HvInfo(..) |
62 | 32389d91 | Helga Velroyen | , StorageInfo(..) |
63 | dc623a95 | Agata Murawska | , RpcCallNodeInfo(..) |
64 | dc623a95 | Agata Murawska | , RpcResultNodeInfo(..) |
65 | dc623a95 | Agata Murawska | |
66 | 8779d21a | Agata Murawska | , RpcCallVersion(..) |
67 | 8779d21a | Agata Murawska | , RpcResultVersion(..) |
68 | 8779d21a | Agata Murawska | |
69 | 47163f0f | Agata Murawska | , RpcCallStorageList(..) |
70 | 47163f0f | Agata Murawska | , RpcResultStorageList(..) |
71 | 47163f0f | Agata Murawska | |
72 | de2a5704 | Iustin Pop | , RpcCallTestDelay(..) |
73 | de2a5704 | Iustin Pop | , RpcResultTestDelay(..) |
74 | de2a5704 | Iustin Pop | |
75 | 842515dd | Iustin Pop | , RpcCallExportList(..) |
76 | 842515dd | Iustin Pop | , RpcResultExportList(..) |
77 | d4709cce | Agata Murawska | ) where |
78 | d4709cce | Agata Murawska | |
79 | 9b09c0be | Agata Murawska | import Control.Arrow (second) |
80 | 319322a7 | Bernardo Dal Seno | import qualified Data.Map as Map |
81 | 319322a7 | Bernardo Dal Seno | import Data.Maybe (fromMaybe) |
82 | d4709cce | Agata Murawska | import qualified Text.JSON as J |
83 | 9b09c0be | Agata Murawska | import Text.JSON.Pretty (pp_value) |
84 | d4709cce | Agata Murawska | |
85 | eaed5f19 | Agata Murawska | import Network.Curl |
86 | 7766de33 | Agata Murawska | import qualified Ganeti.Path as P |
87 | eaed5f19 | Agata Murawska | |
88 | 8920fa09 | Iustin Pop | import Ganeti.BasicTypes |
89 | eaed5f19 | Agata Murawska | import qualified Ganeti.Constants as C |
90 | c14ba680 | Hrvoje Ribicic | import Ganeti.JSON |
91 | a246ce76 | Michele Tartara | import Ganeti.Logging |
92 | d4709cce | Agata Murawska | import Ganeti.Objects |
93 | 96dad12d | Agata Murawska | import Ganeti.THH |
94 | 22381768 | Iustin Pop | import Ganeti.Types |
95 | 8920fa09 | Iustin Pop | import Ganeti.Curl.Multi |
96 | 8920fa09 | Iustin Pop | import Ganeti.Utils |
97 | eaed5f19 | Agata Murawska | |
98 | de2a5704 | Iustin Pop | -- * Base RPC functionality and types |
99 | de2a5704 | Iustin Pop | |
100 | eaed5f19 | Agata Murawska | -- | The curl options used for RPC. |
101 | eaed5f19 | Agata Murawska | curlOpts :: [CurlOption] |
102 | eaed5f19 | Agata Murawska | curlOpts = [ CurlFollowLocation False |
103 | eaed5f19 | Agata Murawska | , CurlSSLVerifyHost 0 |
104 | eaed5f19 | Agata Murawska | , CurlSSLVerifyPeer True |
105 | eaed5f19 | Agata Murawska | , CurlSSLCertType "PEM" |
106 | eaed5f19 | Agata Murawska | , CurlSSLKeyType "PEM" |
107 | eaed5f19 | Agata Murawska | , CurlConnectTimeout (fromIntegral C.rpcConnectTimeout) |
108 | eaed5f19 | Agata Murawska | ] |
109 | d4709cce | Agata Murawska | |
110 | d4709cce | Agata Murawska | -- | Data type for RPC error reporting. |
111 | d4709cce | Agata Murawska | data RpcError |
112 | 9c0a27d0 | Iustin Pop | = CurlLayerError String |
113 | d4709cce | Agata Murawska | | JsonDecodeError String |
114 | 6fddde87 | Agata Murawska | | RpcResultError String |
115 | 9c0a27d0 | Iustin Pop | | OfflineNodeError |
116 | 60443f61 | Agata Murawska | deriving (Show, Eq) |
117 | d4709cce | Agata Murawska | |
118 | 60443f61 | Agata Murawska | -- | Provide explanation to RPC errors. |
119 | 60443f61 | Agata Murawska | explainRpcError :: RpcError -> String |
120 | 9c0a27d0 | Iustin Pop | explainRpcError (CurlLayerError code) = |
121 | 9c0a27d0 | Iustin Pop | "Curl error:" ++ code |
122 | 60443f61 | Agata Murawska | explainRpcError (JsonDecodeError msg) = |
123 | 6fddde87 | Agata Murawska | "Error while decoding JSON from HTTP response: " ++ msg |
124 | 60443f61 | Agata Murawska | explainRpcError (RpcResultError msg) = |
125 | 6fddde87 | Agata Murawska | "Error reponse received from RPC server: " ++ msg |
126 | 9c0a27d0 | Iustin Pop | explainRpcError OfflineNodeError = |
127 | 9c0a27d0 | Iustin Pop | "Node is marked offline" |
128 | d4709cce | Agata Murawska | |
129 | 599239ad | Agata Murawska | type ERpcError = Either RpcError |
130 | 599239ad | Agata Murawska | |
131 | d4709cce | Agata Murawska | -- | A generic class for RPC calls. |
132 | d4709cce | Agata Murawska | class (J.JSON a) => RpcCall a where |
133 | d4709cce | Agata Murawska | -- | Give the (Python) name of the procedure. |
134 | d4709cce | Agata Murawska | rpcCallName :: a -> String |
135 | d4709cce | Agata Murawska | -- | Calculate the timeout value for the call execution. |
136 | d4709cce | Agata Murawska | rpcCallTimeout :: a -> Int |
137 | d4709cce | Agata Murawska | -- | Prepare arguments of the call to be send as POST. |
138 | d4709cce | Agata Murawska | rpcCallData :: Node -> a -> String |
139 | d4709cce | Agata Murawska | -- | Whether we accept offline nodes when making a call. |
140 | d4709cce | Agata Murawska | rpcCallAcceptOffline :: a -> Bool |
141 | d4709cce | Agata Murawska | |
142 | d4709cce | Agata Murawska | -- | Generic class that ensures matching RPC call with its respective |
143 | d4709cce | Agata Murawska | -- result. |
144 | 47163f0f | Agata Murawska | class (RpcCall a, J.JSON b) => Rpc a b | a -> b, b -> a where |
145 | 47163f0f | Agata Murawska | -- | Create a result based on the received HTTP response. |
146 | a93b711b | Agata Murawska | rpcResultFill :: a -> J.JSValue -> ERpcError b |
147 | eaed5f19 | Agata Murawska | |
148 | eaed5f19 | Agata Murawska | -- | Http Request definition. |
149 | eaed5f19 | Agata Murawska | data HttpClientRequest = HttpClientRequest |
150 | 85f6a869 | Iustin Pop | { requestUrl :: String -- ^ The actual URL for the node endpoint |
151 | 85f6a869 | Iustin Pop | , requestData :: String -- ^ The arguments for the call |
152 | 85f6a869 | Iustin Pop | , requestOpts :: [CurlOption] -- ^ The various curl options |
153 | eaed5f19 | Agata Murawska | } |
154 | eaed5f19 | Agata Murawska | |
155 | eaed5f19 | Agata Murawska | -- | Prepare url for the HTTP request. |
156 | eaed5f19 | Agata Murawska | prepareUrl :: (RpcCall a) => Node -> a -> String |
157 | eaed5f19 | Agata Murawska | prepareUrl node call = |
158 | eaed5f19 | Agata Murawska | let node_ip = nodePrimaryIp node |
159 | 6dc0cb59 | Jose A. Lopes | port = C.defaultNodedPort |
160 | 5b11f8db | Iustin Pop | path_prefix = "https://" ++ node_ip ++ ":" ++ show port |
161 | 5b11f8db | Iustin Pop | in path_prefix ++ "/" ++ rpcCallName call |
162 | eaed5f19 | Agata Murawska | |
163 | eaed5f19 | Agata Murawska | -- | Create HTTP request for a given node provided it is online, |
164 | eaed5f19 | Agata Murawska | -- otherwise create empty response. |
165 | 85f6a869 | Iustin Pop | prepareHttpRequest :: (RpcCall a) => [CurlOption] -> Node -> a |
166 | 599239ad | Agata Murawska | -> ERpcError HttpClientRequest |
167 | 85f6a869 | Iustin Pop | prepareHttpRequest opts node call |
168 | 5b11f8db | Iustin Pop | | rpcCallAcceptOffline call || not (nodeOffline node) = |
169 | 85f6a869 | Iustin Pop | Right HttpClientRequest { requestUrl = prepareUrl node call |
170 | 85f6a869 | Iustin Pop | , requestData = rpcCallData node call |
171 | 85f6a869 | Iustin Pop | , requestOpts = opts ++ curlOpts |
172 | 5b11f8db | Iustin Pop | } |
173 | 9c0a27d0 | Iustin Pop | | otherwise = Left OfflineNodeError |
174 | eaed5f19 | Agata Murawska | |
175 | 8920fa09 | Iustin Pop | -- | Parse an HTTP reply. |
176 | 8920fa09 | Iustin Pop | parseHttpReply :: (Rpc a b) => |
177 | 8920fa09 | Iustin Pop | a -> ERpcError (CurlCode, String) -> ERpcError b |
178 | 8920fa09 | Iustin Pop | parseHttpReply _ (Left e) = Left e |
179 | 8920fa09 | Iustin Pop | parseHttpReply call (Right (CurlOK, body)) = parseHttpResponse call body |
180 | 8920fa09 | Iustin Pop | parseHttpReply _ (Right (code, err)) = |
181 | 8920fa09 | Iustin Pop | Left . CurlLayerError $ "code: " ++ show code ++ ", explanation: " ++ err |
182 | 8920fa09 | Iustin Pop | |
183 | 9b09c0be | Agata Murawska | -- | Parse a result based on the received HTTP response. |
184 | 8920fa09 | Iustin Pop | parseHttpResponse :: (Rpc a b) => a -> String -> ERpcError b |
185 | 8920fa09 | Iustin Pop | parseHttpResponse call res = |
186 | a93b711b | Agata Murawska | case J.decode res of |
187 | a93b711b | Agata Murawska | J.Error val -> Left $ JsonDecodeError val |
188 | a93b711b | Agata Murawska | J.Ok (True, res'') -> rpcResultFill call res'' |
189 | a93b711b | Agata Murawska | J.Ok (False, jerr) -> case jerr of |
190 | a93b711b | Agata Murawska | J.JSString msg -> Left $ RpcResultError (J.fromJSString msg) |
191 | a93b711b | Agata Murawska | _ -> Left . JsonDecodeError $ show (pp_value jerr) |
192 | 9b09c0be | Agata Murawska | |
193 | a246ce76 | Michele Tartara | -- | Scan the list of results produced by executeRpcCall and log all the RPC |
194 | a246ce76 | Michele Tartara | -- errors. |
195 | a246ce76 | Michele Tartara | logRpcErrors :: [(a, ERpcError b)] -> IO () |
196 | a246ce76 | Michele Tartara | logRpcErrors allElems = |
197 | a246ce76 | Michele Tartara | let logOneRpcErr (_, Right _) = return () |
198 | a246ce76 | Michele Tartara | logOneRpcErr (_, Left err) = |
199 | a246ce76 | Michele Tartara | logError $ "Error in the RPC HTTP reply: " ++ show err |
200 | a246ce76 | Michele Tartara | in mapM_ logOneRpcErr allElems |
201 | a246ce76 | Michele Tartara | |
202 | ad56f735 | Hrvoje Ribicic | -- | Get options for RPC call |
203 | ad56f735 | Hrvoje Ribicic | getOptionsForCall :: (Rpc a b) => FilePath -> a -> [CurlOption] |
204 | ad56f735 | Hrvoje Ribicic | getOptionsForCall certPath call = |
205 | ad56f735 | Hrvoje Ribicic | [ CurlTimeout (fromIntegral $ rpcCallTimeout call) |
206 | ad56f735 | Hrvoje Ribicic | , CurlSSLCert certPath |
207 | ad56f735 | Hrvoje Ribicic | , CurlSSLKey certPath |
208 | ad56f735 | Hrvoje Ribicic | , CurlCAInfo certPath |
209 | ad56f735 | Hrvoje Ribicic | ] |
210 | ad56f735 | Hrvoje Ribicic | |
211 | ad56f735 | Hrvoje Ribicic | -- | Execute multiple RPC calls in parallel |
212 | ad56f735 | Hrvoje Ribicic | executeRpcCalls :: (Rpc a b) => [(Node, a)] -> IO [(Node, ERpcError b)] |
213 | ad56f735 | Hrvoje Ribicic | executeRpcCalls nodeCalls = do |
214 | 85f6a869 | Iustin Pop | cert_file <- P.nodedCertFile |
215 | ad56f735 | Hrvoje Ribicic | let (nodes, calls) = unzip nodeCalls |
216 | ad56f735 | Hrvoje Ribicic | opts = map (getOptionsForCall cert_file) calls |
217 | ad56f735 | Hrvoje Ribicic | opts_urls = zipWith3 (\n c o -> |
218 | ad56f735 | Hrvoje Ribicic | case prepareHttpRequest o n c of |
219 | 8920fa09 | Iustin Pop | Left v -> Left v |
220 | 8920fa09 | Iustin Pop | Right request -> |
221 | 8920fa09 | Iustin Pop | Right (CurlPostFields [requestData request]: |
222 | 8920fa09 | Iustin Pop | requestOpts request, |
223 | 8920fa09 | Iustin Pop | requestUrl request) |
224 | ad56f735 | Hrvoje Ribicic | ) nodes calls opts |
225 | 8920fa09 | Iustin Pop | -- split the opts_urls list; we don't want to pass the |
226 | 8920fa09 | Iustin Pop | -- failed-already nodes to Curl |
227 | 8920fa09 | Iustin Pop | let (lefts, rights, trail) = splitEithers opts_urls |
228 | 8920fa09 | Iustin Pop | results <- execMultiCall rights |
229 | 8920fa09 | Iustin Pop | results' <- case recombineEithers lefts results trail of |
230 | 8920fa09 | Iustin Pop | Bad msg -> error msg |
231 | 8920fa09 | Iustin Pop | Ok r -> return r |
232 | 8920fa09 | Iustin Pop | -- now parse the replies |
233 | ad56f735 | Hrvoje Ribicic | let results'' = zipWith parseHttpReply calls results' |
234 | c393abbf | Michele Tartara | pairedList = zip nodes results'' |
235 | c393abbf | Michele Tartara | logRpcErrors pairedList |
236 | c393abbf | Michele Tartara | return pairedList |
237 | 96dad12d | Agata Murawska | |
238 | ad56f735 | Hrvoje Ribicic | -- | Execute an RPC call for many nodes in parallel. |
239 | ad56f735 | Hrvoje Ribicic | executeRpcCall :: (Rpc a b) => [Node] -> a -> IO [(Node, ERpcError b)] |
240 | ad56f735 | Hrvoje Ribicic | executeRpcCall nodes call = executeRpcCalls . zip nodes $ repeat call |
241 | ad56f735 | Hrvoje Ribicic | |
242 | 9b09c0be | Agata Murawska | -- | Helper function that is used to read dictionaries of values. |
243 | 9b09c0be | Agata Murawska | sanitizeDictResults :: [(String, J.Result a)] -> ERpcError [(String, a)] |
244 | 3d3f562b | Agata Murawska | sanitizeDictResults = |
245 | 3d3f562b | Agata Murawska | foldr sanitize1 (Right []) |
246 | 3d3f562b | Agata Murawska | where |
247 | 3d3f562b | Agata Murawska | sanitize1 _ (Left e) = Left e |
248 | 3d3f562b | Agata Murawska | sanitize1 (_, J.Error e) _ = Left $ JsonDecodeError e |
249 | 3d3f562b | Agata Murawska | sanitize1 (name, J.Ok v) (Right res) = Right $ (name, v) : res |
250 | 9b09c0be | Agata Murawska | |
251 | 7328a28c | Agata Murawska | -- | Helper function to tranform JSON Result to Either RpcError b. |
252 | 7328a28c | Agata Murawska | -- Note: For now we really only use it for b s.t. Rpc c b for some c |
253 | 7328a28c | Agata Murawska | fromJResultToRes :: J.Result a -> (a -> b) -> ERpcError b |
254 | 7328a28c | Agata Murawska | fromJResultToRes (J.Error v) _ = Left $ JsonDecodeError v |
255 | 7328a28c | Agata Murawska | fromJResultToRes (J.Ok v) f = Right $ f v |
256 | 7328a28c | Agata Murawska | |
257 | 7328a28c | Agata Murawska | -- | Helper function transforming JSValue to Rpc result type. |
258 | 7328a28c | Agata Murawska | fromJSValueToRes :: (J.JSON a) => J.JSValue -> (a -> b) -> ERpcError b |
259 | 7328a28c | Agata Murawska | fromJSValueToRes val = fromJResultToRes (J.readJSON val) |
260 | 7328a28c | Agata Murawska | |
261 | 96dad12d | Agata Murawska | -- * RPC calls and results |
262 | 96dad12d | Agata Murawska | |
263 | de2a5704 | Iustin Pop | -- ** Instance info |
264 | de2a5704 | Iustin Pop | |
265 | b9e12624 | Hrvoje Ribicic | -- | Returns information about a single instance |
266 | 5188fdb7 | Agata Murawska | $(buildObject "RpcCallInstanceInfo" "rpcCallInstInfo" |
267 | 5188fdb7 | Agata Murawska | [ simpleField "instance" [t| String |] |
268 | 5188fdb7 | Agata Murawska | , simpleField "hname" [t| Hypervisor |] |
269 | 5188fdb7 | Agata Murawska | ]) |
270 | 96dad12d | Agata Murawska | |
271 | 5b11f8db | Iustin Pop | $(buildObject "InstanceInfo" "instInfo" |
272 | 9b09c0be | Agata Murawska | [ simpleField "memory" [t| Int|] |
273 | 9b09c0be | Agata Murawska | , simpleField "state" [t| String |] -- It depends on hypervisor :( |
274 | 96dad12d | Agata Murawska | , simpleField "vcpus" [t| Int |] |
275 | 96dad12d | Agata Murawska | , simpleField "time" [t| Int |] |
276 | 96dad12d | Agata Murawska | ]) |
277 | 96dad12d | Agata Murawska | |
278 | 5188fdb7 | Agata Murawska | -- This is optional here because the result may be empty if instance is |
279 | 5188fdb7 | Agata Murawska | -- not on a node - and this is not considered an error. |
280 | 5188fdb7 | Agata Murawska | $(buildObject "RpcResultInstanceInfo" "rpcResInstInfo" |
281 | 5188fdb7 | Agata Murawska | [ optionalField $ simpleField "inst_info" [t| InstanceInfo |]]) |
282 | 5188fdb7 | Agata Murawska | |
283 | 5188fdb7 | Agata Murawska | instance RpcCall RpcCallInstanceInfo where |
284 | 274366e5 | Agata Murawska | rpcCallName _ = "instance_info" |
285 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
286 | 5188fdb7 | Agata Murawska | rpcCallAcceptOffline _ = False |
287 | 274366e5 | Agata Murawska | rpcCallData _ call = J.encode |
288 | 5188fdb7 | Agata Murawska | ( rpcCallInstInfoInstance call |
289 | 5188fdb7 | Agata Murawska | , rpcCallInstInfoHname call |
290 | 5188fdb7 | Agata Murawska | ) |
291 | 5188fdb7 | Agata Murawska | |
292 | 5188fdb7 | Agata Murawska | instance Rpc RpcCallInstanceInfo RpcResultInstanceInfo where |
293 | 5188fdb7 | Agata Murawska | rpcResultFill _ res = |
294 | a93b711b | Agata Murawska | case res of |
295 | 5188fdb7 | Agata Murawska | J.JSObject res' -> |
296 | 5188fdb7 | Agata Murawska | case J.fromJSObject res' of |
297 | 5188fdb7 | Agata Murawska | [] -> Right $ RpcResultInstanceInfo Nothing |
298 | 7328a28c | Agata Murawska | _ -> fromJSValueToRes res (RpcResultInstanceInfo . Just) |
299 | 5188fdb7 | Agata Murawska | _ -> Left $ JsonDecodeError |
300 | 70c2362e | Agata Murawska | ("Expected JSObject, got " ++ show (pp_value res)) |
301 | 5188fdb7 | Agata Murawska | |
302 | de2a5704 | Iustin Pop | -- ** AllInstancesInfo |
303 | de2a5704 | Iustin Pop | |
304 | b9e12624 | Hrvoje Ribicic | -- | Returns information about all running instances on the given nodes |
305 | 5188fdb7 | Agata Murawska | $(buildObject "RpcCallAllInstancesInfo" "rpcCallAllInstInfo" |
306 | c14ba680 | Hrvoje Ribicic | [ simpleField "hypervisors" [t| [(Hypervisor, HvParams)] |] ]) |
307 | 5188fdb7 | Agata Murawska | |
308 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultAllInstancesInfo" "rpcResAllInstInfo" |
309 | 9b09c0be | Agata Murawska | [ simpleField "instances" [t| [(String, InstanceInfo)] |] ]) |
310 | 96dad12d | Agata Murawska | |
311 | 96dad12d | Agata Murawska | instance RpcCall RpcCallAllInstancesInfo where |
312 | 274366e5 | Agata Murawska | rpcCallName _ = "all_instances_info" |
313 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
314 | 96dad12d | Agata Murawska | rpcCallAcceptOffline _ = False |
315 | c14ba680 | Hrvoje Ribicic | rpcCallData _ call = J.encode ( |
316 | c14ba680 | Hrvoje Ribicic | map fst $ rpcCallAllInstInfoHypervisors call, |
317 | c14ba680 | Hrvoje Ribicic | GenericContainer . Map.fromList $ rpcCallAllInstInfoHypervisors call) |
318 | 9b09c0be | Agata Murawska | |
319 | 47163f0f | Agata Murawska | instance Rpc RpcCallAllInstancesInfo RpcResultAllInstancesInfo where |
320 | 9b09c0be | Agata Murawska | -- FIXME: Is there a simpler way to do it? |
321 | 47163f0f | Agata Murawska | rpcResultFill _ res = |
322 | a93b711b | Agata Murawska | case res of |
323 | a93b711b | Agata Murawska | J.JSObject res' -> |
324 | 9b09c0be | Agata Murawska | let res'' = map (second J.readJSON) (J.fromJSObject res') |
325 | a93b711b | Agata Murawska | :: [(String, J.Result InstanceInfo)] in |
326 | 9b09c0be | Agata Murawska | case sanitizeDictResults res'' of |
327 | 9b09c0be | Agata Murawska | Left err -> Left err |
328 | 9b09c0be | Agata Murawska | Right insts -> Right $ RpcResultAllInstancesInfo insts |
329 | 9b09c0be | Agata Murawska | _ -> Left $ JsonDecodeError |
330 | 70c2362e | Agata Murawska | ("Expected JSObject, got " ++ show (pp_value res)) |
331 | 96dad12d | Agata Murawska | |
332 | b9e12624 | Hrvoje Ribicic | -- ** InstanceConsoleInfo |
333 | b9e12624 | Hrvoje Ribicic | |
334 | b9e12624 | Hrvoje Ribicic | -- | Returns information about how to access instances on the given node |
335 | b9e12624 | Hrvoje Ribicic | $(buildObject "InstanceConsoleInfoParams" "instConsInfoParams" |
336 | b9e12624 | Hrvoje Ribicic | [ simpleField "instance" [t| Instance |] |
337 | b9e12624 | Hrvoje Ribicic | , simpleField "node" [t| Node |] |
338 | b9e12624 | Hrvoje Ribicic | , simpleField "hvParams" [t| HvParams |] |
339 | b9e12624 | Hrvoje Ribicic | , simpleField "beParams" [t| FilledBeParams |] |
340 | b9e12624 | Hrvoje Ribicic | ]) |
341 | b9e12624 | Hrvoje Ribicic | |
342 | b9e12624 | Hrvoje Ribicic | $(buildObject "RpcCallInstanceConsoleInfo" "rpcCallInstConsInfo" |
343 | b9e12624 | Hrvoje Ribicic | [ simpleField "instanceInfo" [t| [(String, InstanceConsoleInfoParams)] |] ]) |
344 | b9e12624 | Hrvoje Ribicic | |
345 | b9e12624 | Hrvoje Ribicic | $(buildObject "InstanceConsoleInfo" "instConsInfo" |
346 | b9e12624 | Hrvoje Ribicic | [ simpleField "instance" [t| String |] |
347 | b9e12624 | Hrvoje Ribicic | , simpleField "kind" [t| String |] |
348 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
349 | b9e12624 | Hrvoje Ribicic | simpleField "message" [t| String |] |
350 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
351 | b9e12624 | Hrvoje Ribicic | simpleField "host" [t| String |] |
352 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
353 | b9e12624 | Hrvoje Ribicic | simpleField "port" [t| Int |] |
354 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
355 | b9e12624 | Hrvoje Ribicic | simpleField "user" [t| String |] |
356 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
357 | b9e12624 | Hrvoje Ribicic | simpleField "command" [t| [String] |] |
358 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
359 | b9e12624 | Hrvoje Ribicic | simpleField "display" [t| String |] |
360 | b9e12624 | Hrvoje Ribicic | ]) |
361 | b9e12624 | Hrvoje Ribicic | |
362 | b9e12624 | Hrvoje Ribicic | $(buildObject "RpcResultInstanceConsoleInfo" "rpcResInstConsInfo" |
363 | b9e12624 | Hrvoje Ribicic | [ simpleField "instancesInfo" [t| [(String, InstanceConsoleInfo)] |] ]) |
364 | b9e12624 | Hrvoje Ribicic | |
365 | b9e12624 | Hrvoje Ribicic | instance RpcCall RpcCallInstanceConsoleInfo where |
366 | b9e12624 | Hrvoje Ribicic | rpcCallName _ = "instance_console_info" |
367 | b9e12624 | Hrvoje Ribicic | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
368 | b9e12624 | Hrvoje Ribicic | rpcCallAcceptOffline _ = False |
369 | b9e12624 | Hrvoje Ribicic | rpcCallData _ call = J.encode . |
370 | b9e12624 | Hrvoje Ribicic | GenericContainer $ Map.fromList (rpcCallInstConsInfoInstanceInfo call) |
371 | b9e12624 | Hrvoje Ribicic | |
372 | b9e12624 | Hrvoje Ribicic | instance Rpc RpcCallInstanceConsoleInfo RpcResultInstanceConsoleInfo where |
373 | b9e12624 | Hrvoje Ribicic | rpcResultFill _ res = |
374 | b9e12624 | Hrvoje Ribicic | case res of |
375 | b9e12624 | Hrvoje Ribicic | J.JSObject res' -> |
376 | b9e12624 | Hrvoje Ribicic | let res'' = map (second J.readJSON) (J.fromJSObject res') |
377 | b9e12624 | Hrvoje Ribicic | :: [(String, J.Result InstanceConsoleInfo)] in |
378 | b9e12624 | Hrvoje Ribicic | case sanitizeDictResults res'' of |
379 | b9e12624 | Hrvoje Ribicic | Left err -> Left err |
380 | b9e12624 | Hrvoje Ribicic | Right instInfos -> Right $ RpcResultInstanceConsoleInfo instInfos |
381 | b9e12624 | Hrvoje Ribicic | _ -> Left $ JsonDecodeError |
382 | b9e12624 | Hrvoje Ribicic | ("Expected JSObject, got " ++ show (pp_value res)) |
383 | b9e12624 | Hrvoje Ribicic | |
384 | de2a5704 | Iustin Pop | -- ** InstanceList |
385 | de2a5704 | Iustin Pop | |
386 | b9e12624 | Hrvoje Ribicic | -- | Returns the list of running instances on the given nodes |
387 | 5b11f8db | Iustin Pop | $(buildObject "RpcCallInstanceList" "rpcCallInstList" |
388 | c1c5aab1 | Agata Murawska | [ simpleField "hypervisors" [t| [Hypervisor] |] ]) |
389 | c1c5aab1 | Agata Murawska | |
390 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultInstanceList" "rpcResInstList" |
391 | 9b09c0be | Agata Murawska | [ simpleField "instances" [t| [String] |] ]) |
392 | c1c5aab1 | Agata Murawska | |
393 | c1c5aab1 | Agata Murawska | instance RpcCall RpcCallInstanceList where |
394 | 274366e5 | Agata Murawska | rpcCallName _ = "instance_list" |
395 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
396 | c1c5aab1 | Agata Murawska | rpcCallAcceptOffline _ = False |
397 | 274366e5 | Agata Murawska | rpcCallData _ call = J.encode [rpcCallInstListHypervisors call] |
398 | c1c5aab1 | Agata Murawska | |
399 | 47163f0f | Agata Murawska | instance Rpc RpcCallInstanceList RpcResultInstanceList where |
400 | 7328a28c | Agata Murawska | rpcResultFill _ res = fromJSValueToRes res RpcResultInstanceList |
401 | c1c5aab1 | Agata Murawska | |
402 | de2a5704 | Iustin Pop | -- ** NodeInfo |
403 | de2a5704 | Iustin Pop | |
404 | b9e12624 | Hrvoje Ribicic | -- | Returns node information |
405 | 5b11f8db | Iustin Pop | $(buildObject "RpcCallNodeInfo" "rpcCallNodeInfo" |
406 | 212b66c3 | Helga Velroyen | [ simpleField "storage_units" [t| Map.Map String [StorageUnit] |] |
407 | 030ab01a | Helga Velroyen | , simpleField "hypervisors" [t| [ (Hypervisor, HvParams) ] |] |
408 | dc623a95 | Agata Murawska | ]) |
409 | dc623a95 | Agata Murawska | |
410 | 32389d91 | Helga Velroyen | $(buildObject "StorageInfo" "storageInfo" |
411 | dc623a95 | Agata Murawska | [ simpleField "name" [t| String |] |
412 | 0f0f6d7d | Helga Velroyen | , simpleField "type" [t| String |] |
413 | 32389d91 | Helga Velroyen | , optionalField $ simpleField "storage_free" [t| Int |] |
414 | 32389d91 | Helga Velroyen | , optionalField $ simpleField "storage_size" [t| Int |] |
415 | dc623a95 | Agata Murawska | ]) |
416 | dc623a95 | Agata Murawska | |
417 | dc623a95 | Agata Murawska | -- | We only provide common fields as described in hv_base.py. |
418 | 5b11f8db | Iustin Pop | $(buildObject "HvInfo" "hvInfo" |
419 | dc623a95 | Agata Murawska | [ simpleField "memory_total" [t| Int |] |
420 | dc623a95 | Agata Murawska | , simpleField "memory_free" [t| Int |] |
421 | dc623a95 | Agata Murawska | , simpleField "memory_dom0" [t| Int |] |
422 | dc623a95 | Agata Murawska | , simpleField "cpu_total" [t| Int |] |
423 | dc623a95 | Agata Murawska | , simpleField "cpu_nodes" [t| Int |] |
424 | dc623a95 | Agata Murawska | , simpleField "cpu_sockets" [t| Int |] |
425 | f43c898d | Bernardo Dal Seno | , simpleField "cpu_dom0" [t| Int |] |
426 | dc623a95 | Agata Murawska | ]) |
427 | dc623a95 | Agata Murawska | |
428 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultNodeInfo" "rpcResNodeInfo" |
429 | dc623a95 | Agata Murawska | [ simpleField "boot_id" [t| String |] |
430 | 32389d91 | Helga Velroyen | , simpleField "storage_info" [t| [StorageInfo] |] |
431 | dc623a95 | Agata Murawska | , simpleField "hv_info" [t| [HvInfo] |] |
432 | dc623a95 | Agata Murawska | ]) |
433 | dc623a95 | Agata Murawska | |
434 | dc623a95 | Agata Murawska | instance RpcCall RpcCallNodeInfo where |
435 | 274366e5 | Agata Murawska | rpcCallName _ = "node_info" |
436 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
437 | dc623a95 | Agata Murawska | rpcCallAcceptOffline _ = False |
438 | 319322a7 | Bernardo Dal Seno | rpcCallData n call = J.encode |
439 | 212b66c3 | Helga Velroyen | ( fromMaybe (error $ "Programmer error: missing parameter for node named " |
440 | 319322a7 | Bernardo Dal Seno | ++ nodeName n) |
441 | 212b66c3 | Helga Velroyen | $ Map.lookup (nodeUuid n) (rpcCallNodeInfoStorageUnits call) |
442 | 212b66c3 | Helga Velroyen | , rpcCallNodeInfoHypervisors call |
443 | 274366e5 | Agata Murawska | ) |
444 | 9b09c0be | Agata Murawska | |
445 | 47163f0f | Agata Murawska | instance Rpc RpcCallNodeInfo RpcResultNodeInfo where |
446 | 47163f0f | Agata Murawska | rpcResultFill _ res = |
447 | 7328a28c | Agata Murawska | fromJSValueToRes res (\(b, vg, hv) -> RpcResultNodeInfo b vg hv) |
448 | dc623a95 | Agata Murawska | |
449 | de2a5704 | Iustin Pop | -- ** Version |
450 | de2a5704 | Iustin Pop | |
451 | 08f7d24d | Iustin Pop | -- | Query node version. |
452 | 08f7d24d | Iustin Pop | $(buildObject "RpcCallVersion" "rpcCallVersion" []) |
453 | 8779d21a | Agata Murawska | |
454 | 08f7d24d | Iustin Pop | -- | Query node reply. |
455 | 8779d21a | Agata Murawska | $(buildObject "RpcResultVersion" "rpcResultVersion" |
456 | 8779d21a | Agata Murawska | [ simpleField "version" [t| Int |] |
457 | 8779d21a | Agata Murawska | ]) |
458 | 8779d21a | Agata Murawska | |
459 | 8779d21a | Agata Murawska | instance RpcCall RpcCallVersion where |
460 | 274366e5 | Agata Murawska | rpcCallName _ = "version" |
461 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
462 | 8779d21a | Agata Murawska | rpcCallAcceptOffline _ = True |
463 | ff8f0049 | Iustin Pop | rpcCallData _ = J.encode |
464 | 8779d21a | Agata Murawska | |
465 | 47163f0f | Agata Murawska | instance Rpc RpcCallVersion RpcResultVersion where |
466 | 7328a28c | Agata Murawska | rpcResultFill _ res = fromJSValueToRes res RpcResultVersion |
467 | 8779d21a | Agata Murawska | |
468 | de2a5704 | Iustin Pop | -- ** StorageList |
469 | de2a5704 | Iustin Pop | |
470 | 47163f0f | Agata Murawska | $(buildObject "RpcCallStorageList" "rpcCallStorageList" |
471 | 47163f0f | Agata Murawska | [ simpleField "su_name" [t| StorageType |] |
472 | 47163f0f | Agata Murawska | , simpleField "su_args" [t| [String] |] |
473 | 47163f0f | Agata Murawska | , simpleField "name" [t| String |] |
474 | 47163f0f | Agata Murawska | , simpleField "fields" [t| [StorageField] |] |
475 | 47163f0f | Agata Murawska | ]) |
476 | 47163f0f | Agata Murawska | |
477 | 47163f0f | Agata Murawska | -- FIXME: The resulting JSValues should have types appropriate for their |
478 | 47163f0f | Agata Murawska | -- StorageField value: Used -> Bool, Name -> String etc |
479 | 47163f0f | Agata Murawska | $(buildObject "RpcResultStorageList" "rpcResStorageList" |
480 | 47163f0f | Agata Murawska | [ simpleField "storage" [t| [[(StorageField, J.JSValue)]] |] ]) |
481 | 47163f0f | Agata Murawska | |
482 | 47163f0f | Agata Murawska | instance RpcCall RpcCallStorageList where |
483 | 274366e5 | Agata Murawska | rpcCallName _ = "storage_list" |
484 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Normal |
485 | 47163f0f | Agata Murawska | rpcCallAcceptOffline _ = False |
486 | 274366e5 | Agata Murawska | rpcCallData _ call = J.encode |
487 | 47163f0f | Agata Murawska | ( rpcCallStorageListSuName call |
488 | 47163f0f | Agata Murawska | , rpcCallStorageListSuArgs call |
489 | 47163f0f | Agata Murawska | , rpcCallStorageListName call |
490 | 47163f0f | Agata Murawska | , rpcCallStorageListFields call |
491 | 47163f0f | Agata Murawska | ) |
492 | 47163f0f | Agata Murawska | |
493 | 47163f0f | Agata Murawska | instance Rpc RpcCallStorageList RpcResultStorageList where |
494 | 47163f0f | Agata Murawska | rpcResultFill call res = |
495 | 47163f0f | Agata Murawska | let sfields = rpcCallStorageListFields call in |
496 | 7328a28c | Agata Murawska | fromJSValueToRes res (RpcResultStorageList . map (zip sfields)) |
497 | de2a5704 | Iustin Pop | |
498 | de2a5704 | Iustin Pop | -- ** TestDelay |
499 | de2a5704 | Iustin Pop | |
500 | de2a5704 | Iustin Pop | -- | Call definition for test delay. |
501 | de2a5704 | Iustin Pop | $(buildObject "RpcCallTestDelay" "rpcCallTestDelay" |
502 | de2a5704 | Iustin Pop | [ simpleField "duration" [t| Double |] |
503 | de2a5704 | Iustin Pop | ]) |
504 | de2a5704 | Iustin Pop | |
505 | de2a5704 | Iustin Pop | -- | Result definition for test delay. |
506 | de2a5704 | Iustin Pop | data RpcResultTestDelay = RpcResultTestDelay |
507 | de2a5704 | Iustin Pop | deriving Show |
508 | de2a5704 | Iustin Pop | |
509 | de2a5704 | Iustin Pop | -- | Custom JSON instance for null result. |
510 | de2a5704 | Iustin Pop | instance J.JSON RpcResultTestDelay where |
511 | de2a5704 | Iustin Pop | showJSON _ = J.JSNull |
512 | de2a5704 | Iustin Pop | readJSON J.JSNull = return RpcResultTestDelay |
513 | de2a5704 | Iustin Pop | readJSON _ = fail "Unable to read RpcResultTestDelay" |
514 | de2a5704 | Iustin Pop | |
515 | de2a5704 | Iustin Pop | instance RpcCall RpcCallTestDelay where |
516 | de2a5704 | Iustin Pop | rpcCallName _ = "test_delay" |
517 | de2a5704 | Iustin Pop | rpcCallTimeout = ceiling . (+ 5) . rpcCallTestDelayDuration |
518 | de2a5704 | Iustin Pop | rpcCallAcceptOffline _ = False |
519 | de2a5704 | Iustin Pop | rpcCallData _ call = J.encode [rpcCallTestDelayDuration call] |
520 | de2a5704 | Iustin Pop | |
521 | de2a5704 | Iustin Pop | instance Rpc RpcCallTestDelay RpcResultTestDelay where |
522 | de2a5704 | Iustin Pop | rpcResultFill _ res = fromJSValueToRes res id |
523 | 842515dd | Iustin Pop | |
524 | 842515dd | Iustin Pop | -- ** ExportList |
525 | 842515dd | Iustin Pop | |
526 | 842515dd | Iustin Pop | -- | Call definition for export list. |
527 | 842515dd | Iustin Pop | |
528 | 842515dd | Iustin Pop | $(buildObject "RpcCallExportList" "rpcCallExportList" []) |
529 | 842515dd | Iustin Pop | |
530 | 842515dd | Iustin Pop | -- | Result definition for export list. |
531 | 842515dd | Iustin Pop | $(buildObject "RpcResultExportList" "rpcResExportList" |
532 | 842515dd | Iustin Pop | [ simpleField "exports" [t| [String] |] |
533 | 842515dd | Iustin Pop | ]) |
534 | 842515dd | Iustin Pop | |
535 | 842515dd | Iustin Pop | instance RpcCall RpcCallExportList where |
536 | 842515dd | Iustin Pop | rpcCallName _ = "export_list" |
537 | 842515dd | Iustin Pop | rpcCallTimeout _ = rpcTimeoutToRaw Fast |
538 | 842515dd | Iustin Pop | rpcCallAcceptOffline _ = False |
539 | 842515dd | Iustin Pop | rpcCallData _ = J.encode |
540 | 842515dd | Iustin Pop | |
541 | 842515dd | Iustin Pop | instance Rpc RpcCallExportList RpcResultExportList where |
542 | 842515dd | Iustin Pop | rpcResultFill _ res = fromJSValueToRes res RpcResultExportList |