root / src / Ganeti / Rpc.hs @ 9a8952e0
History | View | Annotate | Download (26.1 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 | 8e527d04 | Petr Pudlak | , rpcErrors |
38 | a246ce76 | Michele Tartara | , logRpcErrors |
39 | d4709cce | Agata Murawska | |
40 | d4709cce | Agata Murawska | , rpcCallName |
41 | d4709cce | Agata Murawska | , rpcCallTimeout |
42 | d4709cce | Agata Murawska | , rpcCallData |
43 | d4709cce | Agata Murawska | , rpcCallAcceptOffline |
44 | d4709cce | Agata Murawska | |
45 | d4709cce | Agata Murawska | , rpcResultFill |
46 | 96dad12d | Agata Murawska | |
47 | d6f05205 | Petr Pudlak | , Compressed |
48 | d6f05205 | Petr Pudlak | , packCompressed |
49 | d6f05205 | Petr Pudlak | , toCompressed |
50 | d6f05205 | Petr Pudlak | , getCompressed |
51 | d6f05205 | Petr Pudlak | |
52 | 5188fdb7 | Agata Murawska | , RpcCallInstanceInfo(..) |
53 | 14933c17 | Jose A. Lopes | , InstanceState(..) |
54 | 14933c17 | Jose A. Lopes | , InstanceInfo(..) |
55 | 5188fdb7 | Agata Murawska | , RpcResultInstanceInfo(..) |
56 | 5188fdb7 | Agata Murawska | |
57 | 96dad12d | Agata Murawska | , RpcCallAllInstancesInfo(..) |
58 | 96dad12d | Agata Murawska | , RpcResultAllInstancesInfo(..) |
59 | 96dad12d | Agata Murawska | |
60 | b9e12624 | Hrvoje Ribicic | , InstanceConsoleInfoParams(..) |
61 | b9e12624 | Hrvoje Ribicic | , InstanceConsoleInfo(..) |
62 | b9e12624 | Hrvoje Ribicic | , RpcCallInstanceConsoleInfo(..) |
63 | b9e12624 | Hrvoje Ribicic | , RpcResultInstanceConsoleInfo(..) |
64 | b9e12624 | Hrvoje Ribicic | |
65 | c1c5aab1 | Agata Murawska | , RpcCallInstanceList(..) |
66 | c1c5aab1 | Agata Murawska | , RpcResultInstanceList(..) |
67 | c1c5aab1 | Agata Murawska | |
68 | dc623a95 | Agata Murawska | , HvInfo(..) |
69 | 32389d91 | Helga Velroyen | , StorageInfo(..) |
70 | dc623a95 | Agata Murawska | , RpcCallNodeInfo(..) |
71 | dc623a95 | Agata Murawska | , RpcResultNodeInfo(..) |
72 | dc623a95 | Agata Murawska | |
73 | 8779d21a | Agata Murawska | , RpcCallVersion(..) |
74 | 8779d21a | Agata Murawska | , RpcResultVersion(..) |
75 | 8779d21a | Agata Murawska | |
76 | 47163f0f | Agata Murawska | , RpcCallStorageList(..) |
77 | 47163f0f | Agata Murawska | , RpcResultStorageList(..) |
78 | 47163f0f | Agata Murawska | |
79 | de2a5704 | Iustin Pop | , RpcCallTestDelay(..) |
80 | de2a5704 | Iustin Pop | , RpcResultTestDelay(..) |
81 | de2a5704 | Iustin Pop | |
82 | 842515dd | Iustin Pop | , RpcCallExportList(..) |
83 | 842515dd | Iustin Pop | , RpcResultExportList(..) |
84 | a716edba | Klaus Aehlig | |
85 | a716edba | Klaus Aehlig | , RpcCallJobqueueUpdate(..) |
86 | 40ad3e85 | Klaus Aehlig | , RpcCallJobqueueRename(..) |
87 | 5ce9cc30 | Klaus Aehlig | , RpcCallSetWatcherPause(..) |
88 | 83a451f5 | Klaus Aehlig | , RpcCallSetDrainFlag(..) |
89 | b6eee126 | Petr Pudlak | |
90 | b6eee126 | Petr Pudlak | , RpcCallUploadFile(..) |
91 | b6eee126 | Petr Pudlak | , prepareRpcCallUploadFile |
92 | 9a8952e0 | Petr Pudlak | , RpcCallWriteSsconfFiles(..) |
93 | d4709cce | Agata Murawska | ) where |
94 | d4709cce | Agata Murawska | |
95 | 9b09c0be | Agata Murawska | import Control.Arrow (second) |
96 | d6f05205 | Petr Pudlak | import Control.Monad |
97 | 835050f3 | Klaus Aehlig | import qualified Data.ByteString.Lazy.Char8 as BL |
98 | 319322a7 | Bernardo Dal Seno | import qualified Data.Map as Map |
99 | 8e527d04 | Petr Pudlak | import Data.Maybe (fromMaybe, mapMaybe) |
100 | d4709cce | Agata Murawska | import qualified Text.JSON as J |
101 | 9b09c0be | Agata Murawska | import Text.JSON.Pretty (pp_value) |
102 | 835050f3 | Klaus Aehlig | import qualified Data.ByteString.Base64.Lazy as Base64 |
103 | d5104ca4 | Helga Velroyen | import System.Directory |
104 | b6eee126 | Petr Pudlak | import System.Posix.Files ( modificationTime, accessTime, fileOwner |
105 | b6eee126 | Petr Pudlak | , fileGroup, fileMode, getFileStatus) |
106 | d4709cce | Agata Murawska | |
107 | a716edba | Klaus Aehlig | import Network.Curl hiding (content) |
108 | 7766de33 | Agata Murawska | import qualified Ganeti.Path as P |
109 | eaed5f19 | Agata Murawska | |
110 | 8920fa09 | Iustin Pop | import Ganeti.BasicTypes |
111 | eaed5f19 | Agata Murawska | import qualified Ganeti.Constants as C |
112 | d6f05205 | Petr Pudlak | import Ganeti.Codec |
113 | d6f05205 | Petr Pudlak | import Ganeti.Curl.Multi |
114 | b6eee126 | Petr Pudlak | import Ganeti.Errors |
115 | c14ba680 | Hrvoje Ribicic | import Ganeti.JSON |
116 | a246ce76 | Michele Tartara | import Ganeti.Logging |
117 | d4709cce | Agata Murawska | import Ganeti.Objects |
118 | b6eee126 | Petr Pudlak | import Ganeti.Runtime |
119 | 9a8952e0 | Petr Pudlak | import Ganeti.Ssconf |
120 | 96dad12d | Agata Murawska | import Ganeti.THH |
121 | 72375ff8 | Petr Pudlak | import Ganeti.THH.Field |
122 | 22381768 | Iustin Pop | import Ganeti.Types |
123 | 8920fa09 | Iustin Pop | import Ganeti.Utils |
124 | b6eee126 | Petr Pudlak | import Ganeti.VCluster |
125 | eaed5f19 | Agata Murawska | |
126 | de2a5704 | Iustin Pop | -- * Base RPC functionality and types |
127 | de2a5704 | Iustin Pop | |
128 | eaed5f19 | Agata Murawska | -- | The curl options used for RPC. |
129 | eaed5f19 | Agata Murawska | curlOpts :: [CurlOption] |
130 | eaed5f19 | Agata Murawska | curlOpts = [ CurlFollowLocation False |
131 | eaed5f19 | Agata Murawska | , CurlSSLVerifyHost 0 |
132 | eaed5f19 | Agata Murawska | , CurlSSLVerifyPeer True |
133 | eaed5f19 | Agata Murawska | , CurlSSLCertType "PEM" |
134 | eaed5f19 | Agata Murawska | , CurlSSLKeyType "PEM" |
135 | eaed5f19 | Agata Murawska | , CurlConnectTimeout (fromIntegral C.rpcConnectTimeout) |
136 | eaed5f19 | Agata Murawska | ] |
137 | d4709cce | Agata Murawska | |
138 | d4709cce | Agata Murawska | -- | Data type for RPC error reporting. |
139 | d4709cce | Agata Murawska | data RpcError |
140 | 9c0a27d0 | Iustin Pop | = CurlLayerError String |
141 | d4709cce | Agata Murawska | | JsonDecodeError String |
142 | 6fddde87 | Agata Murawska | | RpcResultError String |
143 | 9c0a27d0 | Iustin Pop | | OfflineNodeError |
144 | 60443f61 | Agata Murawska | deriving (Show, Eq) |
145 | d4709cce | Agata Murawska | |
146 | 60443f61 | Agata Murawska | -- | Provide explanation to RPC errors. |
147 | 60443f61 | Agata Murawska | explainRpcError :: RpcError -> String |
148 | 9c0a27d0 | Iustin Pop | explainRpcError (CurlLayerError code) = |
149 | 9c0a27d0 | Iustin Pop | "Curl error:" ++ code |
150 | 60443f61 | Agata Murawska | explainRpcError (JsonDecodeError msg) = |
151 | 6fddde87 | Agata Murawska | "Error while decoding JSON from HTTP response: " ++ msg |
152 | 60443f61 | Agata Murawska | explainRpcError (RpcResultError msg) = |
153 | 6fddde87 | Agata Murawska | "Error reponse received from RPC server: " ++ msg |
154 | 9c0a27d0 | Iustin Pop | explainRpcError OfflineNodeError = |
155 | 9c0a27d0 | Iustin Pop | "Node is marked offline" |
156 | d4709cce | Agata Murawska | |
157 | 599239ad | Agata Murawska | type ERpcError = Either RpcError |
158 | 599239ad | Agata Murawska | |
159 | d4709cce | Agata Murawska | -- | A generic class for RPC calls. |
160 | 35cded14 | Petr Pudlak | class (ArrayObject a) => RpcCall a where |
161 | d4709cce | Agata Murawska | -- | Give the (Python) name of the procedure. |
162 | d4709cce | Agata Murawska | rpcCallName :: a -> String |
163 | d4709cce | Agata Murawska | -- | Calculate the timeout value for the call execution. |
164 | d4709cce | Agata Murawska | rpcCallTimeout :: a -> Int |
165 | d4709cce | Agata Murawska | -- | Prepare arguments of the call to be send as POST. |
166 | d4709cce | Agata Murawska | rpcCallData :: Node -> a -> String |
167 | 35cded14 | Petr Pudlak | rpcCallData _ = J.encode . J.JSArray . toJSArray |
168 | d4709cce | Agata Murawska | -- | Whether we accept offline nodes when making a call. |
169 | d4709cce | Agata Murawska | rpcCallAcceptOffline :: a -> Bool |
170 | d4709cce | Agata Murawska | |
171 | d4709cce | Agata Murawska | -- | Generic class that ensures matching RPC call with its respective |
172 | d4709cce | Agata Murawska | -- result. |
173 | 47163f0f | Agata Murawska | class (RpcCall a, J.JSON b) => Rpc a b | a -> b, b -> a where |
174 | 47163f0f | Agata Murawska | -- | Create a result based on the received HTTP response. |
175 | a93b711b | Agata Murawska | rpcResultFill :: a -> J.JSValue -> ERpcError b |
176 | eaed5f19 | Agata Murawska | |
177 | eaed5f19 | Agata Murawska | -- | Http Request definition. |
178 | eaed5f19 | Agata Murawska | data HttpClientRequest = HttpClientRequest |
179 | 85f6a869 | Iustin Pop | { requestUrl :: String -- ^ The actual URL for the node endpoint |
180 | 85f6a869 | Iustin Pop | , requestData :: String -- ^ The arguments for the call |
181 | 85f6a869 | Iustin Pop | , requestOpts :: [CurlOption] -- ^ The various curl options |
182 | eaed5f19 | Agata Murawska | } |
183 | eaed5f19 | Agata Murawska | |
184 | b5c3a4f2 | Guido Trotter | -- | Check if a string represented address is IPv6 |
185 | b5c3a4f2 | Guido Trotter | isIpV6 :: String -> Bool |
186 | 289e7fcc | Klaus Aehlig | isIpV6 = (':' `elem`) |
187 | b5c3a4f2 | Guido Trotter | |
188 | eaed5f19 | Agata Murawska | -- | Prepare url for the HTTP request. |
189 | eaed5f19 | Agata Murawska | prepareUrl :: (RpcCall a) => Node -> a -> String |
190 | eaed5f19 | Agata Murawska | prepareUrl node call = |
191 | eaed5f19 | Agata Murawska | let node_ip = nodePrimaryIp node |
192 | b5c3a4f2 | Guido Trotter | node_address = if isIpV6 node_ip |
193 | b5c3a4f2 | Guido Trotter | then "[" ++ node_ip ++ "]" |
194 | b5c3a4f2 | Guido Trotter | else node_ip |
195 | 6dc0cb59 | Jose A. Lopes | port = C.defaultNodedPort |
196 | b5c3a4f2 | Guido Trotter | path_prefix = "https://" ++ node_address ++ ":" ++ show port |
197 | 5b11f8db | Iustin Pop | in path_prefix ++ "/" ++ rpcCallName call |
198 | eaed5f19 | Agata Murawska | |
199 | eaed5f19 | Agata Murawska | -- | Create HTTP request for a given node provided it is online, |
200 | eaed5f19 | Agata Murawska | -- otherwise create empty response. |
201 | 85f6a869 | Iustin Pop | prepareHttpRequest :: (RpcCall a) => [CurlOption] -> Node -> a |
202 | 599239ad | Agata Murawska | -> ERpcError HttpClientRequest |
203 | 85f6a869 | Iustin Pop | prepareHttpRequest opts node call |
204 | 5b11f8db | Iustin Pop | | rpcCallAcceptOffline call || not (nodeOffline node) = |
205 | 85f6a869 | Iustin Pop | Right HttpClientRequest { requestUrl = prepareUrl node call |
206 | 85f6a869 | Iustin Pop | , requestData = rpcCallData node call |
207 | 85f6a869 | Iustin Pop | , requestOpts = opts ++ curlOpts |
208 | 5b11f8db | Iustin Pop | } |
209 | 9c0a27d0 | Iustin Pop | | otherwise = Left OfflineNodeError |
210 | eaed5f19 | Agata Murawska | |
211 | 8920fa09 | Iustin Pop | -- | Parse an HTTP reply. |
212 | 8920fa09 | Iustin Pop | parseHttpReply :: (Rpc a b) => |
213 | 8920fa09 | Iustin Pop | a -> ERpcError (CurlCode, String) -> ERpcError b |
214 | 8920fa09 | Iustin Pop | parseHttpReply _ (Left e) = Left e |
215 | 8920fa09 | Iustin Pop | parseHttpReply call (Right (CurlOK, body)) = parseHttpResponse call body |
216 | 8920fa09 | Iustin Pop | parseHttpReply _ (Right (code, err)) = |
217 | 8920fa09 | Iustin Pop | Left . CurlLayerError $ "code: " ++ show code ++ ", explanation: " ++ err |
218 | 8920fa09 | Iustin Pop | |
219 | 9b09c0be | Agata Murawska | -- | Parse a result based on the received HTTP response. |
220 | 8920fa09 | Iustin Pop | parseHttpResponse :: (Rpc a b) => a -> String -> ERpcError b |
221 | 8920fa09 | Iustin Pop | parseHttpResponse call res = |
222 | a93b711b | Agata Murawska | case J.decode res of |
223 | a93b711b | Agata Murawska | J.Error val -> Left $ JsonDecodeError val |
224 | a93b711b | Agata Murawska | J.Ok (True, res'') -> rpcResultFill call res'' |
225 | a93b711b | Agata Murawska | J.Ok (False, jerr) -> case jerr of |
226 | a93b711b | Agata Murawska | J.JSString msg -> Left $ RpcResultError (J.fromJSString msg) |
227 | a93b711b | Agata Murawska | _ -> Left . JsonDecodeError $ show (pp_value jerr) |
228 | 9b09c0be | Agata Murawska | |
229 | 8e527d04 | Petr Pudlak | -- | Scan the list of results produced by executeRpcCall and extract |
230 | 8e527d04 | Petr Pudlak | -- all the RPC errors. |
231 | 8e527d04 | Petr Pudlak | rpcErrors :: [(a, ERpcError b)] -> [(a, RpcError)] |
232 | 8e527d04 | Petr Pudlak | rpcErrors = |
233 | 8e527d04 | Petr Pudlak | let rpcErr (node, Left err) = Just (node, err) |
234 | 8e527d04 | Petr Pudlak | rpcErr _ = Nothing |
235 | 8e527d04 | Petr Pudlak | in mapMaybe rpcErr |
236 | 8e527d04 | Petr Pudlak | |
237 | a246ce76 | Michele Tartara | -- | Scan the list of results produced by executeRpcCall and log all the RPC |
238 | 8e527d04 | Petr Pudlak | -- errors. Returns the list of errors for further processing. |
239 | 8e527d04 | Petr Pudlak | logRpcErrors :: (MonadLog m, Show a) => [(a, ERpcError b)] |
240 | 8e527d04 | Petr Pudlak | -> m [(a, RpcError)] |
241 | 8e527d04 | Petr Pudlak | logRpcErrors rs = |
242 | 8e527d04 | Petr Pudlak | let logOneRpcErr (node, err) = |
243 | 8e527d04 | Petr Pudlak | logError $ "Error in the RPC HTTP reply from '" ++ |
244 | 8e527d04 | Petr Pudlak | show node ++ "': " ++ show err |
245 | 8e527d04 | Petr Pudlak | errs = rpcErrors rs |
246 | 8e527d04 | Petr Pudlak | in mapM_ logOneRpcErr errs >> return errs |
247 | a246ce76 | Michele Tartara | |
248 | ad56f735 | Hrvoje Ribicic | -- | Get options for RPC call |
249 | b3cc1646 | Helga Velroyen | getOptionsForCall :: (Rpc a b) => FilePath -> FilePath -> a -> [CurlOption] |
250 | b3cc1646 | Helga Velroyen | getOptionsForCall cert_path client_cert_path call = |
251 | ad56f735 | Hrvoje Ribicic | [ CurlTimeout (fromIntegral $ rpcCallTimeout call) |
252 | b3cc1646 | Helga Velroyen | , CurlSSLCert client_cert_path |
253 | b3cc1646 | Helga Velroyen | , CurlSSLKey client_cert_path |
254 | b3cc1646 | Helga Velroyen | , CurlCAInfo cert_path |
255 | ad56f735 | Hrvoje Ribicic | ] |
256 | ad56f735 | Hrvoje Ribicic | |
257 | ad56f735 | Hrvoje Ribicic | -- | Execute multiple RPC calls in parallel |
258 | ad56f735 | Hrvoje Ribicic | executeRpcCalls :: (Rpc a b) => [(Node, a)] -> IO [(Node, ERpcError b)] |
259 | ad56f735 | Hrvoje Ribicic | executeRpcCalls nodeCalls = do |
260 | 85f6a869 | Iustin Pop | cert_file <- P.nodedCertFile |
261 | d5104ca4 | Helga Velroyen | client_cert_file_name <- P.nodedClientCertFile |
262 | d5104ca4 | Helga Velroyen | client_file_exists <- doesFileExist client_cert_file_name |
263 | d5104ca4 | Helga Velroyen | -- FIXME: This is needed to ensure upgradability to 2.11 |
264 | d5104ca4 | Helga Velroyen | -- Remove in 2.12. |
265 | d5104ca4 | Helga Velroyen | let client_cert_file = if client_file_exists |
266 | d5104ca4 | Helga Velroyen | then client_cert_file_name |
267 | d5104ca4 | Helga Velroyen | else cert_file |
268 | d5104ca4 | Helga Velroyen | (nodes, calls) = unzip nodeCalls |
269 | d5104ca4 | Helga Velroyen | opts = map (getOptionsForCall cert_file client_cert_file) calls |
270 | ad56f735 | Hrvoje Ribicic | opts_urls = zipWith3 (\n c o -> |
271 | ad56f735 | Hrvoje Ribicic | case prepareHttpRequest o n c of |
272 | 8920fa09 | Iustin Pop | Left v -> Left v |
273 | 8920fa09 | Iustin Pop | Right request -> |
274 | 8920fa09 | Iustin Pop | Right (CurlPostFields [requestData request]: |
275 | 8920fa09 | Iustin Pop | requestOpts request, |
276 | 8920fa09 | Iustin Pop | requestUrl request) |
277 | ad56f735 | Hrvoje Ribicic | ) nodes calls opts |
278 | 8920fa09 | Iustin Pop | -- split the opts_urls list; we don't want to pass the |
279 | 8920fa09 | Iustin Pop | -- failed-already nodes to Curl |
280 | 8920fa09 | Iustin Pop | let (lefts, rights, trail) = splitEithers opts_urls |
281 | 8920fa09 | Iustin Pop | results <- execMultiCall rights |
282 | 8920fa09 | Iustin Pop | results' <- case recombineEithers lefts results trail of |
283 | 8920fa09 | Iustin Pop | Bad msg -> error msg |
284 | 8920fa09 | Iustin Pop | Ok r -> return r |
285 | 8920fa09 | Iustin Pop | -- now parse the replies |
286 | ad56f735 | Hrvoje Ribicic | let results'' = zipWith parseHttpReply calls results' |
287 | c393abbf | Michele Tartara | pairedList = zip nodes results'' |
288 | 8e527d04 | Petr Pudlak | _ <- logRpcErrors pairedList |
289 | c393abbf | Michele Tartara | return pairedList |
290 | 96dad12d | Agata Murawska | |
291 | ad56f735 | Hrvoje Ribicic | -- | Execute an RPC call for many nodes in parallel. |
292 | ad56f735 | Hrvoje Ribicic | executeRpcCall :: (Rpc a b) => [Node] -> a -> IO [(Node, ERpcError b)] |
293 | ad56f735 | Hrvoje Ribicic | executeRpcCall nodes call = executeRpcCalls . zip nodes $ repeat call |
294 | ad56f735 | Hrvoje Ribicic | |
295 | 9b09c0be | Agata Murawska | -- | Helper function that is used to read dictionaries of values. |
296 | 9b09c0be | Agata Murawska | sanitizeDictResults :: [(String, J.Result a)] -> ERpcError [(String, a)] |
297 | 3d3f562b | Agata Murawska | sanitizeDictResults = |
298 | 3d3f562b | Agata Murawska | foldr sanitize1 (Right []) |
299 | 3d3f562b | Agata Murawska | where |
300 | 3d3f562b | Agata Murawska | sanitize1 _ (Left e) = Left e |
301 | 3d3f562b | Agata Murawska | sanitize1 (_, J.Error e) _ = Left $ JsonDecodeError e |
302 | 3d3f562b | Agata Murawska | sanitize1 (name, J.Ok v) (Right res) = Right $ (name, v) : res |
303 | 9b09c0be | Agata Murawska | |
304 | 7328a28c | Agata Murawska | -- | Helper function to tranform JSON Result to Either RpcError b. |
305 | 7328a28c | Agata Murawska | -- Note: For now we really only use it for b s.t. Rpc c b for some c |
306 | 7328a28c | Agata Murawska | fromJResultToRes :: J.Result a -> (a -> b) -> ERpcError b |
307 | 7328a28c | Agata Murawska | fromJResultToRes (J.Error v) _ = Left $ JsonDecodeError v |
308 | 7328a28c | Agata Murawska | fromJResultToRes (J.Ok v) f = Right $ f v |
309 | 7328a28c | Agata Murawska | |
310 | 7328a28c | Agata Murawska | -- | Helper function transforming JSValue to Rpc result type. |
311 | 7328a28c | Agata Murawska | fromJSValueToRes :: (J.JSON a) => J.JSValue -> (a -> b) -> ERpcError b |
312 | 7328a28c | Agata Murawska | fromJSValueToRes val = fromJResultToRes (J.readJSON val) |
313 | 7328a28c | Agata Murawska | |
314 | d6f05205 | Petr Pudlak | -- | An opaque data type for representing data that should be compressed |
315 | d6f05205 | Petr Pudlak | -- over the wire. |
316 | d6f05205 | Petr Pudlak | -- |
317 | d6f05205 | Petr Pudlak | -- On Python side it is decompressed by @backend._Decompress@. |
318 | d6f05205 | Petr Pudlak | newtype Compressed = Compressed { getCompressed :: BL.ByteString } |
319 | d6f05205 | Petr Pudlak | deriving (Eq, Ord, Show) |
320 | d6f05205 | Petr Pudlak | |
321 | d6f05205 | Petr Pudlak | -- TODO Add a unit test for all octets |
322 | d6f05205 | Petr Pudlak | instance J.JSON Compressed where |
323 | d6f05205 | Petr Pudlak | showJSON = J.showJSON |
324 | d6f05205 | Petr Pudlak | . (,) C.rpcEncodingZlibBase64 |
325 | d6f05205 | Petr Pudlak | . Base64.encode . compressZlib . getCompressed |
326 | d6f05205 | Petr Pudlak | readJSON = J.readJSON >=> decompress |
327 | d6f05205 | Petr Pudlak | where |
328 | d6f05205 | Petr Pudlak | decompress (enc, cont) |
329 | d6f05205 | Petr Pudlak | | enc == C.rpcEncodingNone = |
330 | d6f05205 | Petr Pudlak | return $ Compressed cont |
331 | d6f05205 | Petr Pudlak | | enc == C.rpcEncodingZlibBase64 = |
332 | d6f05205 | Petr Pudlak | liftM Compressed |
333 | d6f05205 | Petr Pudlak | . either fail return . decompressZlib |
334 | d6f05205 | Petr Pudlak | <=< either (fail . ("Base64: " ++)) return . Base64.decode |
335 | d6f05205 | Petr Pudlak | $ cont |
336 | d6f05205 | Petr Pudlak | | otherwise = |
337 | d6f05205 | Petr Pudlak | fail $ "Unknown RPC encoding type: " ++ show enc |
338 | d6f05205 | Petr Pudlak | |
339 | d6f05205 | Petr Pudlak | packCompressed :: BL.ByteString -> Compressed |
340 | d6f05205 | Petr Pudlak | packCompressed = Compressed |
341 | d6f05205 | Petr Pudlak | |
342 | d6f05205 | Petr Pudlak | toCompressed :: String -> Compressed |
343 | d6f05205 | Petr Pudlak | toCompressed = packCompressed . BL.pack |
344 | d6f05205 | Petr Pudlak | |
345 | 96dad12d | Agata Murawska | -- * RPC calls and results |
346 | 96dad12d | Agata Murawska | |
347 | de2a5704 | Iustin Pop | -- ** Instance info |
348 | de2a5704 | Iustin Pop | |
349 | b9e12624 | Hrvoje Ribicic | -- | Returns information about a single instance |
350 | 5188fdb7 | Agata Murawska | $(buildObject "RpcCallInstanceInfo" "rpcCallInstInfo" |
351 | 5188fdb7 | Agata Murawska | [ simpleField "instance" [t| String |] |
352 | 5188fdb7 | Agata Murawska | , simpleField "hname" [t| Hypervisor |] |
353 | 5188fdb7 | Agata Murawska | ]) |
354 | 96dad12d | Agata Murawska | |
355 | 14933c17 | Jose A. Lopes | $(declareILADT "InstanceState" |
356 | 14933c17 | Jose A. Lopes | [ ("InstanceStateRunning", 0) |
357 | 14933c17 | Jose A. Lopes | , ("InstanceStateShutdown", 1) |
358 | 14933c17 | Jose A. Lopes | ]) |
359 | 14933c17 | Jose A. Lopes | |
360 | 14933c17 | Jose A. Lopes | $(makeJSONInstance ''InstanceState) |
361 | 14933c17 | Jose A. Lopes | |
362 | 14933c17 | Jose A. Lopes | instance PyValue InstanceState where |
363 | 14933c17 | Jose A. Lopes | showValue = show . instanceStateToRaw |
364 | 14933c17 | Jose A. Lopes | |
365 | 5b11f8db | Iustin Pop | $(buildObject "InstanceInfo" "instInfo" |
366 | 9b09c0be | Agata Murawska | [ simpleField "memory" [t| Int|] |
367 | 14933c17 | Jose A. Lopes | , simpleField "state" [t| InstanceState |] |
368 | 96dad12d | Agata Murawska | , simpleField "vcpus" [t| Int |] |
369 | 96dad12d | Agata Murawska | , simpleField "time" [t| Int |] |
370 | 96dad12d | Agata Murawska | ]) |
371 | 96dad12d | Agata Murawska | |
372 | 5188fdb7 | Agata Murawska | -- This is optional here because the result may be empty if instance is |
373 | 5188fdb7 | Agata Murawska | -- not on a node - and this is not considered an error. |
374 | 5188fdb7 | Agata Murawska | $(buildObject "RpcResultInstanceInfo" "rpcResInstInfo" |
375 | 5188fdb7 | Agata Murawska | [ optionalField $ simpleField "inst_info" [t| InstanceInfo |]]) |
376 | 5188fdb7 | Agata Murawska | |
377 | 5188fdb7 | Agata Murawska | instance RpcCall RpcCallInstanceInfo where |
378 | 274366e5 | Agata Murawska | rpcCallName _ = "instance_info" |
379 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
380 | 5188fdb7 | Agata Murawska | rpcCallAcceptOffline _ = False |
381 | 5188fdb7 | Agata Murawska | |
382 | 5188fdb7 | Agata Murawska | instance Rpc RpcCallInstanceInfo RpcResultInstanceInfo where |
383 | 5188fdb7 | Agata Murawska | rpcResultFill _ res = |
384 | a93b711b | Agata Murawska | case res of |
385 | 5188fdb7 | Agata Murawska | J.JSObject res' -> |
386 | 5188fdb7 | Agata Murawska | case J.fromJSObject res' of |
387 | 5188fdb7 | Agata Murawska | [] -> Right $ RpcResultInstanceInfo Nothing |
388 | 7328a28c | Agata Murawska | _ -> fromJSValueToRes res (RpcResultInstanceInfo . Just) |
389 | 5188fdb7 | Agata Murawska | _ -> Left $ JsonDecodeError |
390 | 70c2362e | Agata Murawska | ("Expected JSObject, got " ++ show (pp_value res)) |
391 | 5188fdb7 | Agata Murawska | |
392 | de2a5704 | Iustin Pop | -- ** AllInstancesInfo |
393 | de2a5704 | Iustin Pop | |
394 | b9e12624 | Hrvoje Ribicic | -- | Returns information about all running instances on the given nodes |
395 | 5188fdb7 | Agata Murawska | $(buildObject "RpcCallAllInstancesInfo" "rpcCallAllInstInfo" |
396 | c14ba680 | Hrvoje Ribicic | [ simpleField "hypervisors" [t| [(Hypervisor, HvParams)] |] ]) |
397 | 5188fdb7 | Agata Murawska | |
398 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultAllInstancesInfo" "rpcResAllInstInfo" |
399 | 9b09c0be | Agata Murawska | [ simpleField "instances" [t| [(String, InstanceInfo)] |] ]) |
400 | 96dad12d | Agata Murawska | |
401 | 96dad12d | Agata Murawska | instance RpcCall RpcCallAllInstancesInfo where |
402 | 274366e5 | Agata Murawska | rpcCallName _ = "all_instances_info" |
403 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
404 | 96dad12d | Agata Murawska | rpcCallAcceptOffline _ = False |
405 | c14ba680 | Hrvoje Ribicic | rpcCallData _ call = J.encode ( |
406 | c14ba680 | Hrvoje Ribicic | map fst $ rpcCallAllInstInfoHypervisors call, |
407 | c14ba680 | Hrvoje Ribicic | GenericContainer . Map.fromList $ rpcCallAllInstInfoHypervisors call) |
408 | 9b09c0be | Agata Murawska | |
409 | 47163f0f | Agata Murawska | instance Rpc RpcCallAllInstancesInfo RpcResultAllInstancesInfo where |
410 | 9b09c0be | Agata Murawska | -- FIXME: Is there a simpler way to do it? |
411 | 47163f0f | Agata Murawska | rpcResultFill _ res = |
412 | a93b711b | Agata Murawska | case res of |
413 | a93b711b | Agata Murawska | J.JSObject res' -> |
414 | 9b09c0be | Agata Murawska | let res'' = map (second J.readJSON) (J.fromJSObject res') |
415 | a93b711b | Agata Murawska | :: [(String, J.Result InstanceInfo)] in |
416 | 9b09c0be | Agata Murawska | case sanitizeDictResults res'' of |
417 | 9b09c0be | Agata Murawska | Left err -> Left err |
418 | 9b09c0be | Agata Murawska | Right insts -> Right $ RpcResultAllInstancesInfo insts |
419 | 9b09c0be | Agata Murawska | _ -> Left $ JsonDecodeError |
420 | 70c2362e | Agata Murawska | ("Expected JSObject, got " ++ show (pp_value res)) |
421 | 96dad12d | Agata Murawska | |
422 | b9e12624 | Hrvoje Ribicic | -- ** InstanceConsoleInfo |
423 | b9e12624 | Hrvoje Ribicic | |
424 | b9e12624 | Hrvoje Ribicic | -- | Returns information about how to access instances on the given node |
425 | b9e12624 | Hrvoje Ribicic | $(buildObject "InstanceConsoleInfoParams" "instConsInfoParams" |
426 | b9e12624 | Hrvoje Ribicic | [ simpleField "instance" [t| Instance |] |
427 | b9e12624 | Hrvoje Ribicic | , simpleField "node" [t| Node |] |
428 | 0808e9d5 | Petr Pudlak | , simpleField "group" [t| NodeGroup |] |
429 | b9e12624 | Hrvoje Ribicic | , simpleField "hvParams" [t| HvParams |] |
430 | b9e12624 | Hrvoje Ribicic | , simpleField "beParams" [t| FilledBeParams |] |
431 | b9e12624 | Hrvoje Ribicic | ]) |
432 | b9e12624 | Hrvoje Ribicic | |
433 | b9e12624 | Hrvoje Ribicic | $(buildObject "RpcCallInstanceConsoleInfo" "rpcCallInstConsInfo" |
434 | b9e12624 | Hrvoje Ribicic | [ simpleField "instanceInfo" [t| [(String, InstanceConsoleInfoParams)] |] ]) |
435 | b9e12624 | Hrvoje Ribicic | |
436 | b9e12624 | Hrvoje Ribicic | $(buildObject "InstanceConsoleInfo" "instConsInfo" |
437 | b9e12624 | Hrvoje Ribicic | [ simpleField "instance" [t| String |] |
438 | b9e12624 | Hrvoje Ribicic | , simpleField "kind" [t| String |] |
439 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
440 | b9e12624 | Hrvoje Ribicic | simpleField "message" [t| String |] |
441 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
442 | b9e12624 | Hrvoje Ribicic | simpleField "host" [t| String |] |
443 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
444 | b9e12624 | Hrvoje Ribicic | simpleField "port" [t| Int |] |
445 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
446 | b9e12624 | Hrvoje Ribicic | simpleField "user" [t| String |] |
447 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
448 | b9e12624 | Hrvoje Ribicic | simpleField "command" [t| [String] |] |
449 | b9e12624 | Hrvoje Ribicic | , optionalField $ |
450 | b9e12624 | Hrvoje Ribicic | simpleField "display" [t| String |] |
451 | b9e12624 | Hrvoje Ribicic | ]) |
452 | b9e12624 | Hrvoje Ribicic | |
453 | b9e12624 | Hrvoje Ribicic | $(buildObject "RpcResultInstanceConsoleInfo" "rpcResInstConsInfo" |
454 | b9e12624 | Hrvoje Ribicic | [ simpleField "instancesInfo" [t| [(String, InstanceConsoleInfo)] |] ]) |
455 | b9e12624 | Hrvoje Ribicic | |
456 | b9e12624 | Hrvoje Ribicic | instance RpcCall RpcCallInstanceConsoleInfo where |
457 | b9e12624 | Hrvoje Ribicic | rpcCallName _ = "instance_console_info" |
458 | b9e12624 | Hrvoje Ribicic | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
459 | b9e12624 | Hrvoje Ribicic | rpcCallAcceptOffline _ = False |
460 | b9e12624 | Hrvoje Ribicic | rpcCallData _ call = J.encode . |
461 | b9e12624 | Hrvoje Ribicic | GenericContainer $ Map.fromList (rpcCallInstConsInfoInstanceInfo call) |
462 | b9e12624 | Hrvoje Ribicic | |
463 | b9e12624 | Hrvoje Ribicic | instance Rpc RpcCallInstanceConsoleInfo RpcResultInstanceConsoleInfo where |
464 | b9e12624 | Hrvoje Ribicic | rpcResultFill _ res = |
465 | b9e12624 | Hrvoje Ribicic | case res of |
466 | b9e12624 | Hrvoje Ribicic | J.JSObject res' -> |
467 | b9e12624 | Hrvoje Ribicic | let res'' = map (second J.readJSON) (J.fromJSObject res') |
468 | b9e12624 | Hrvoje Ribicic | :: [(String, J.Result InstanceConsoleInfo)] in |
469 | b9e12624 | Hrvoje Ribicic | case sanitizeDictResults res'' of |
470 | b9e12624 | Hrvoje Ribicic | Left err -> Left err |
471 | b9e12624 | Hrvoje Ribicic | Right instInfos -> Right $ RpcResultInstanceConsoleInfo instInfos |
472 | b9e12624 | Hrvoje Ribicic | _ -> Left $ JsonDecodeError |
473 | b9e12624 | Hrvoje Ribicic | ("Expected JSObject, got " ++ show (pp_value res)) |
474 | b9e12624 | Hrvoje Ribicic | |
475 | de2a5704 | Iustin Pop | -- ** InstanceList |
476 | de2a5704 | Iustin Pop | |
477 | b9e12624 | Hrvoje Ribicic | -- | Returns the list of running instances on the given nodes |
478 | 5b11f8db | Iustin Pop | $(buildObject "RpcCallInstanceList" "rpcCallInstList" |
479 | c1c5aab1 | Agata Murawska | [ simpleField "hypervisors" [t| [Hypervisor] |] ]) |
480 | c1c5aab1 | Agata Murawska | |
481 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultInstanceList" "rpcResInstList" |
482 | 9b09c0be | Agata Murawska | [ simpleField "instances" [t| [String] |] ]) |
483 | c1c5aab1 | Agata Murawska | |
484 | c1c5aab1 | Agata Murawska | instance RpcCall RpcCallInstanceList where |
485 | 274366e5 | Agata Murawska | rpcCallName _ = "instance_list" |
486 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
487 | c1c5aab1 | Agata Murawska | rpcCallAcceptOffline _ = False |
488 | c1c5aab1 | Agata Murawska | |
489 | 47163f0f | Agata Murawska | instance Rpc RpcCallInstanceList RpcResultInstanceList where |
490 | 7328a28c | Agata Murawska | rpcResultFill _ res = fromJSValueToRes res RpcResultInstanceList |
491 | c1c5aab1 | Agata Murawska | |
492 | de2a5704 | Iustin Pop | -- ** NodeInfo |
493 | de2a5704 | Iustin Pop | |
494 | b9e12624 | Hrvoje Ribicic | -- | Returns node information |
495 | 5b11f8db | Iustin Pop | $(buildObject "RpcCallNodeInfo" "rpcCallNodeInfo" |
496 | 212b66c3 | Helga Velroyen | [ simpleField "storage_units" [t| Map.Map String [StorageUnit] |] |
497 | 030ab01a | Helga Velroyen | , simpleField "hypervisors" [t| [ (Hypervisor, HvParams) ] |] |
498 | dc623a95 | Agata Murawska | ]) |
499 | dc623a95 | Agata Murawska | |
500 | 32389d91 | Helga Velroyen | $(buildObject "StorageInfo" "storageInfo" |
501 | dc623a95 | Agata Murawska | [ simpleField "name" [t| String |] |
502 | 0f0f6d7d | Helga Velroyen | , simpleField "type" [t| String |] |
503 | 32389d91 | Helga Velroyen | , optionalField $ simpleField "storage_free" [t| Int |] |
504 | 32389d91 | Helga Velroyen | , optionalField $ simpleField "storage_size" [t| Int |] |
505 | dc623a95 | Agata Murawska | ]) |
506 | dc623a95 | Agata Murawska | |
507 | dc623a95 | Agata Murawska | -- | We only provide common fields as described in hv_base.py. |
508 | 5b11f8db | Iustin Pop | $(buildObject "HvInfo" "hvInfo" |
509 | dc623a95 | Agata Murawska | [ simpleField "memory_total" [t| Int |] |
510 | dc623a95 | Agata Murawska | , simpleField "memory_free" [t| Int |] |
511 | dc623a95 | Agata Murawska | , simpleField "memory_dom0" [t| Int |] |
512 | dc623a95 | Agata Murawska | , simpleField "cpu_total" [t| Int |] |
513 | dc623a95 | Agata Murawska | , simpleField "cpu_nodes" [t| Int |] |
514 | dc623a95 | Agata Murawska | , simpleField "cpu_sockets" [t| Int |] |
515 | f43c898d | Bernardo Dal Seno | , simpleField "cpu_dom0" [t| Int |] |
516 | dc623a95 | Agata Murawska | ]) |
517 | dc623a95 | Agata Murawska | |
518 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultNodeInfo" "rpcResNodeInfo" |
519 | dc623a95 | Agata Murawska | [ simpleField "boot_id" [t| String |] |
520 | 32389d91 | Helga Velroyen | , simpleField "storage_info" [t| [StorageInfo] |] |
521 | dc623a95 | Agata Murawska | , simpleField "hv_info" [t| [HvInfo] |] |
522 | dc623a95 | Agata Murawska | ]) |
523 | dc623a95 | Agata Murawska | |
524 | dc623a95 | Agata Murawska | instance RpcCall RpcCallNodeInfo where |
525 | 274366e5 | Agata Murawska | rpcCallName _ = "node_info" |
526 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
527 | dc623a95 | Agata Murawska | rpcCallAcceptOffline _ = False |
528 | 319322a7 | Bernardo Dal Seno | rpcCallData n call = J.encode |
529 | 212b66c3 | Helga Velroyen | ( fromMaybe (error $ "Programmer error: missing parameter for node named " |
530 | 319322a7 | Bernardo Dal Seno | ++ nodeName n) |
531 | 212b66c3 | Helga Velroyen | $ Map.lookup (nodeUuid n) (rpcCallNodeInfoStorageUnits call) |
532 | 212b66c3 | Helga Velroyen | , rpcCallNodeInfoHypervisors call |
533 | 274366e5 | Agata Murawska | ) |
534 | 9b09c0be | Agata Murawska | |
535 | 47163f0f | Agata Murawska | instance Rpc RpcCallNodeInfo RpcResultNodeInfo where |
536 | 47163f0f | Agata Murawska | rpcResultFill _ res = |
537 | 7328a28c | Agata Murawska | fromJSValueToRes res (\(b, vg, hv) -> RpcResultNodeInfo b vg hv) |
538 | dc623a95 | Agata Murawska | |
539 | de2a5704 | Iustin Pop | -- ** Version |
540 | de2a5704 | Iustin Pop | |
541 | 08f7d24d | Iustin Pop | -- | Query node version. |
542 | 08f7d24d | Iustin Pop | $(buildObject "RpcCallVersion" "rpcCallVersion" []) |
543 | 8779d21a | Agata Murawska | |
544 | 08f7d24d | Iustin Pop | -- | Query node reply. |
545 | 8779d21a | Agata Murawska | $(buildObject "RpcResultVersion" "rpcResultVersion" |
546 | 8779d21a | Agata Murawska | [ simpleField "version" [t| Int |] |
547 | 8779d21a | Agata Murawska | ]) |
548 | 8779d21a | Agata Murawska | |
549 | 8779d21a | Agata Murawska | instance RpcCall RpcCallVersion where |
550 | 274366e5 | Agata Murawska | rpcCallName _ = "version" |
551 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
552 | 8779d21a | Agata Murawska | rpcCallAcceptOffline _ = True |
553 | ff8f0049 | Iustin Pop | rpcCallData _ = J.encode |
554 | 8779d21a | Agata Murawska | |
555 | 47163f0f | Agata Murawska | instance Rpc RpcCallVersion RpcResultVersion where |
556 | 7328a28c | Agata Murawska | rpcResultFill _ res = fromJSValueToRes res RpcResultVersion |
557 | 8779d21a | Agata Murawska | |
558 | de2a5704 | Iustin Pop | -- ** StorageList |
559 | de2a5704 | Iustin Pop | |
560 | 47163f0f | Agata Murawska | $(buildObject "RpcCallStorageList" "rpcCallStorageList" |
561 | 47163f0f | Agata Murawska | [ simpleField "su_name" [t| StorageType |] |
562 | 47163f0f | Agata Murawska | , simpleField "su_args" [t| [String] |] |
563 | 47163f0f | Agata Murawska | , simpleField "name" [t| String |] |
564 | 47163f0f | Agata Murawska | , simpleField "fields" [t| [StorageField] |] |
565 | 47163f0f | Agata Murawska | ]) |
566 | 47163f0f | Agata Murawska | |
567 | 47163f0f | Agata Murawska | -- FIXME: The resulting JSValues should have types appropriate for their |
568 | 47163f0f | Agata Murawska | -- StorageField value: Used -> Bool, Name -> String etc |
569 | 47163f0f | Agata Murawska | $(buildObject "RpcResultStorageList" "rpcResStorageList" |
570 | 47163f0f | Agata Murawska | [ simpleField "storage" [t| [[(StorageField, J.JSValue)]] |] ]) |
571 | 47163f0f | Agata Murawska | |
572 | 47163f0f | Agata Murawska | instance RpcCall RpcCallStorageList where |
573 | 274366e5 | Agata Murawska | rpcCallName _ = "storage_list" |
574 | 274366e5 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Normal |
575 | 47163f0f | Agata Murawska | rpcCallAcceptOffline _ = False |
576 | 47163f0f | Agata Murawska | |
577 | 47163f0f | Agata Murawska | instance Rpc RpcCallStorageList RpcResultStorageList where |
578 | 47163f0f | Agata Murawska | rpcResultFill call res = |
579 | 47163f0f | Agata Murawska | let sfields = rpcCallStorageListFields call in |
580 | 7328a28c | Agata Murawska | fromJSValueToRes res (RpcResultStorageList . map (zip sfields)) |
581 | de2a5704 | Iustin Pop | |
582 | de2a5704 | Iustin Pop | -- ** TestDelay |
583 | de2a5704 | Iustin Pop | |
584 | de2a5704 | Iustin Pop | -- | Call definition for test delay. |
585 | de2a5704 | Iustin Pop | $(buildObject "RpcCallTestDelay" "rpcCallTestDelay" |
586 | de2a5704 | Iustin Pop | [ simpleField "duration" [t| Double |] |
587 | de2a5704 | Iustin Pop | ]) |
588 | de2a5704 | Iustin Pop | |
589 | de2a5704 | Iustin Pop | -- | Result definition for test delay. |
590 | de2a5704 | Iustin Pop | data RpcResultTestDelay = RpcResultTestDelay |
591 | de2a5704 | Iustin Pop | deriving Show |
592 | de2a5704 | Iustin Pop | |
593 | de2a5704 | Iustin Pop | -- | Custom JSON instance for null result. |
594 | de2a5704 | Iustin Pop | instance J.JSON RpcResultTestDelay where |
595 | de2a5704 | Iustin Pop | showJSON _ = J.JSNull |
596 | de2a5704 | Iustin Pop | readJSON J.JSNull = return RpcResultTestDelay |
597 | de2a5704 | Iustin Pop | readJSON _ = fail "Unable to read RpcResultTestDelay" |
598 | de2a5704 | Iustin Pop | |
599 | de2a5704 | Iustin Pop | instance RpcCall RpcCallTestDelay where |
600 | de2a5704 | Iustin Pop | rpcCallName _ = "test_delay" |
601 | de2a5704 | Iustin Pop | rpcCallTimeout = ceiling . (+ 5) . rpcCallTestDelayDuration |
602 | de2a5704 | Iustin Pop | rpcCallAcceptOffline _ = False |
603 | de2a5704 | Iustin Pop | |
604 | de2a5704 | Iustin Pop | instance Rpc RpcCallTestDelay RpcResultTestDelay where |
605 | de2a5704 | Iustin Pop | rpcResultFill _ res = fromJSValueToRes res id |
606 | 842515dd | Iustin Pop | |
607 | 842515dd | Iustin Pop | -- ** ExportList |
608 | 842515dd | Iustin Pop | |
609 | 842515dd | Iustin Pop | -- | Call definition for export list. |
610 | 842515dd | Iustin Pop | |
611 | 842515dd | Iustin Pop | $(buildObject "RpcCallExportList" "rpcCallExportList" []) |
612 | 842515dd | Iustin Pop | |
613 | 842515dd | Iustin Pop | -- | Result definition for export list. |
614 | 842515dd | Iustin Pop | $(buildObject "RpcResultExportList" "rpcResExportList" |
615 | 842515dd | Iustin Pop | [ simpleField "exports" [t| [String] |] |
616 | 842515dd | Iustin Pop | ]) |
617 | 842515dd | Iustin Pop | |
618 | 842515dd | Iustin Pop | instance RpcCall RpcCallExportList where |
619 | 842515dd | Iustin Pop | rpcCallName _ = "export_list" |
620 | 842515dd | Iustin Pop | rpcCallTimeout _ = rpcTimeoutToRaw Fast |
621 | 842515dd | Iustin Pop | rpcCallAcceptOffline _ = False |
622 | 842515dd | Iustin Pop | rpcCallData _ = J.encode |
623 | 842515dd | Iustin Pop | |
624 | 842515dd | Iustin Pop | instance Rpc RpcCallExportList RpcResultExportList where |
625 | 842515dd | Iustin Pop | rpcResultFill _ res = fromJSValueToRes res RpcResultExportList |
626 | a716edba | Klaus Aehlig | |
627 | a716edba | Klaus Aehlig | -- ** Job Queue Replication |
628 | a716edba | Klaus Aehlig | |
629 | a716edba | Klaus Aehlig | -- | Update a job queue file |
630 | a716edba | Klaus Aehlig | |
631 | a716edba | Klaus Aehlig | $(buildObject "RpcCallJobqueueUpdate" "rpcCallJobqueueUpdate" |
632 | a716edba | Klaus Aehlig | [ simpleField "file_name" [t| String |] |
633 | a716edba | Klaus Aehlig | , simpleField "content" [t| String |] |
634 | a716edba | Klaus Aehlig | ]) |
635 | a716edba | Klaus Aehlig | |
636 | 557f5dad | Klaus Aehlig | $(buildObject "RpcResultJobQueueUpdate" "rpcResultJobQueueUpdate" []) |
637 | 557f5dad | Klaus Aehlig | |
638 | a716edba | Klaus Aehlig | instance RpcCall RpcCallJobqueueUpdate where |
639 | a716edba | Klaus Aehlig | rpcCallName _ = "jobqueue_update" |
640 | a716edba | Klaus Aehlig | rpcCallTimeout _ = rpcTimeoutToRaw Fast |
641 | a716edba | Klaus Aehlig | rpcCallAcceptOffline _ = False |
642 | a716edba | Klaus Aehlig | rpcCallData _ call = J.encode |
643 | a716edba | Klaus Aehlig | ( rpcCallJobqueueUpdateFileName call |
644 | d6f05205 | Petr Pudlak | , toCompressed $ rpcCallJobqueueUpdateContent call |
645 | a716edba | Klaus Aehlig | ) |
646 | a716edba | Klaus Aehlig | |
647 | 557f5dad | Klaus Aehlig | instance Rpc RpcCallJobqueueUpdate RpcResultJobQueueUpdate where |
648 | a716edba | Klaus Aehlig | rpcResultFill _ res = |
649 | a716edba | Klaus Aehlig | case res of |
650 | 557f5dad | Klaus Aehlig | J.JSNull -> Right RpcResultJobQueueUpdate |
651 | a716edba | Klaus Aehlig | _ -> Left $ JsonDecodeError |
652 | a716edba | Klaus Aehlig | ("Expected JSNull, got " ++ show (pp_value res)) |
653 | a716edba | Klaus Aehlig | |
654 | 40ad3e85 | Klaus Aehlig | -- | Rename a file in the job queue |
655 | 40ad3e85 | Klaus Aehlig | |
656 | 40ad3e85 | Klaus Aehlig | $(buildObject "RpcCallJobqueueRename" "rpcCallJobqueueRename" |
657 | 40ad3e85 | Klaus Aehlig | [ simpleField "rename" [t| [(String, String)] |] |
658 | 40ad3e85 | Klaus Aehlig | ]) |
659 | 40ad3e85 | Klaus Aehlig | |
660 | 40ad3e85 | Klaus Aehlig | $(buildObject "RpcResultJobqueueRename" "rpcResultJobqueueRename" []) |
661 | 40ad3e85 | Klaus Aehlig | |
662 | 40ad3e85 | Klaus Aehlig | instance RpcCall RpcCallJobqueueRename where |
663 | 40ad3e85 | Klaus Aehlig | rpcCallName _ = "jobqueue_rename" |
664 | 40ad3e85 | Klaus Aehlig | rpcCallTimeout _ = rpcTimeoutToRaw Fast |
665 | 40ad3e85 | Klaus Aehlig | rpcCallAcceptOffline _ = False |
666 | 40ad3e85 | Klaus Aehlig | |
667 | 40ad3e85 | Klaus Aehlig | instance Rpc RpcCallJobqueueRename RpcResultJobqueueRename where |
668 | f4d0c84a | Klaus Aehlig | rpcResultFill call res = |
669 | f4d0c84a | Klaus Aehlig | -- Upon success, the RPC returns the list of return values of |
670 | f4d0c84a | Klaus Aehlig | -- the rename operations, which is always None, serialized to |
671 | f4d0c84a | Klaus Aehlig | -- null in JSON. |
672 | f4d0c84a | Klaus Aehlig | let expected = J.showJSON . map (const J.JSNull) |
673 | f4d0c84a | Klaus Aehlig | $ rpcCallJobqueueRenameRename call |
674 | f4d0c84a | Klaus Aehlig | in if res == expected |
675 | f4d0c84a | Klaus Aehlig | then Right RpcResultJobqueueRename |
676 | f4d0c84a | Klaus Aehlig | else Left |
677 | f4d0c84a | Klaus Aehlig | $ JsonDecodeError ("Expected JSNull, got " ++ show (pp_value res)) |
678 | 40ad3e85 | Klaus Aehlig | |
679 | 5ce9cc30 | Klaus Aehlig | -- ** Watcher Status Update |
680 | 5ce9cc30 | Klaus Aehlig | |
681 | 5ce9cc30 | Klaus Aehlig | -- | Set the watcher status |
682 | 5ce9cc30 | Klaus Aehlig | |
683 | 5ce9cc30 | Klaus Aehlig | $(buildObject "RpcCallSetWatcherPause" "rpcCallSetWatcherPause" |
684 | ed7f7fd9 | Petr Pudlak | [ optionalField $ timeAsDoubleField "time" |
685 | 5ce9cc30 | Klaus Aehlig | ]) |
686 | 5ce9cc30 | Klaus Aehlig | |
687 | 5ce9cc30 | Klaus Aehlig | instance RpcCall RpcCallSetWatcherPause where |
688 | 5ce9cc30 | Klaus Aehlig | rpcCallName _ = "set_watcher_pause" |
689 | 5ce9cc30 | Klaus Aehlig | rpcCallTimeout _ = rpcTimeoutToRaw Fast |
690 | 5ce9cc30 | Klaus Aehlig | rpcCallAcceptOffline _ = False |
691 | 5ce9cc30 | Klaus Aehlig | |
692 | 5ce9cc30 | Klaus Aehlig | $(buildObject "RpcResultSetWatcherPause" "rpcResultSetWatcherPause" []) |
693 | 5ce9cc30 | Klaus Aehlig | |
694 | 5ce9cc30 | Klaus Aehlig | instance Rpc RpcCallSetWatcherPause RpcResultSetWatcherPause where |
695 | 5ce9cc30 | Klaus Aehlig | rpcResultFill _ res = |
696 | 5ce9cc30 | Klaus Aehlig | case res of |
697 | 5ce9cc30 | Klaus Aehlig | J.JSNull -> Right RpcResultSetWatcherPause |
698 | 5ce9cc30 | Klaus Aehlig | _ -> Left $ JsonDecodeError |
699 | 5ce9cc30 | Klaus Aehlig | ("Expected JSNull, got " ++ show (pp_value res)) |
700 | 5ce9cc30 | Klaus Aehlig | |
701 | 83a451f5 | Klaus Aehlig | -- ** Queue drain status |
702 | 83a451f5 | Klaus Aehlig | |
703 | 83a451f5 | Klaus Aehlig | -- | Set the queu drain flag |
704 | 83a451f5 | Klaus Aehlig | |
705 | 83a451f5 | Klaus Aehlig | $(buildObject "RpcCallSetDrainFlag" "rpcCallSetDrainFlag" |
706 | 83a451f5 | Klaus Aehlig | [ simpleField "value" [t| Bool |] |
707 | 83a451f5 | Klaus Aehlig | ]) |
708 | 83a451f5 | Klaus Aehlig | |
709 | 83a451f5 | Klaus Aehlig | instance RpcCall RpcCallSetDrainFlag where |
710 | 83a451f5 | Klaus Aehlig | rpcCallName _ = "jobqueue_set_drain_flag" |
711 | 83a451f5 | Klaus Aehlig | rpcCallTimeout _ = rpcTimeoutToRaw Fast |
712 | 83a451f5 | Klaus Aehlig | rpcCallAcceptOffline _ = False |
713 | 83a451f5 | Klaus Aehlig | |
714 | 83a451f5 | Klaus Aehlig | $(buildObject "RpcResultSetDrainFlag" "rpcResultSetDrainFalg" []) |
715 | 83a451f5 | Klaus Aehlig | |
716 | 83a451f5 | Klaus Aehlig | instance Rpc RpcCallSetDrainFlag RpcResultSetDrainFlag where |
717 | 83a451f5 | Klaus Aehlig | rpcResultFill _ res = |
718 | 83a451f5 | Klaus Aehlig | case res of |
719 | 83a451f5 | Klaus Aehlig | J.JSNull -> Right RpcResultSetDrainFlag |
720 | 83a451f5 | Klaus Aehlig | _ -> Left $ JsonDecodeError |
721 | 83a451f5 | Klaus Aehlig | ("Expected JSNull, got " ++ show (pp_value res)) |
722 | 83a451f5 | Klaus Aehlig | |
723 | b6eee126 | Petr Pudlak | -- ** Configuration files upload to nodes |
724 | b6eee126 | Petr Pudlak | |
725 | b6eee126 | Petr Pudlak | -- | Upload a configuration file to nodes |
726 | b6eee126 | Petr Pudlak | |
727 | b6eee126 | Petr Pudlak | $(buildObject "RpcCallUploadFile" "rpcCallUploadFile" |
728 | b6eee126 | Petr Pudlak | [ simpleField "file_name" [t| FilePath |] |
729 | b6eee126 | Petr Pudlak | , simpleField "content" [t| Compressed |] |
730 | b6eee126 | Petr Pudlak | , optionalField $ fileModeAsIntField "mode" |
731 | b6eee126 | Petr Pudlak | , simpleField "uid" [t| String |] |
732 | b6eee126 | Petr Pudlak | , simpleField "gid" [t| String |] |
733 | b6eee126 | Petr Pudlak | , timeAsDoubleField "atime" |
734 | b6eee126 | Petr Pudlak | , timeAsDoubleField "mtime" |
735 | b6eee126 | Petr Pudlak | ]) |
736 | b6eee126 | Petr Pudlak | |
737 | b6eee126 | Petr Pudlak | instance RpcCall RpcCallUploadFile where |
738 | b6eee126 | Petr Pudlak | rpcCallName _ = "upload_file_single" |
739 | b6eee126 | Petr Pudlak | rpcCallTimeout _ = rpcTimeoutToRaw Normal |
740 | b6eee126 | Petr Pudlak | rpcCallAcceptOffline _ = False |
741 | b6eee126 | Petr Pudlak | |
742 | b6eee126 | Petr Pudlak | $(buildObject "RpcResultUploadFile" "rpcResultUploadFile" []) |
743 | b6eee126 | Petr Pudlak | |
744 | b6eee126 | Petr Pudlak | instance Rpc RpcCallUploadFile RpcResultUploadFile where |
745 | b6eee126 | Petr Pudlak | rpcResultFill _ res = |
746 | b6eee126 | Petr Pudlak | case res of |
747 | b6eee126 | Petr Pudlak | J.JSNull -> Right RpcResultUploadFile |
748 | b6eee126 | Petr Pudlak | _ -> Left $ JsonDecodeError |
749 | b6eee126 | Petr Pudlak | ("Expected JSNull, got " ++ show (pp_value res)) |
750 | b6eee126 | Petr Pudlak | |
751 | b6eee126 | Petr Pudlak | -- | Reads a file and constructs the corresponding 'RpcCallUploadFile' value. |
752 | b6eee126 | Petr Pudlak | prepareRpcCallUploadFile :: RuntimeEnts -> FilePath |
753 | b6eee126 | Petr Pudlak | -> ResultG RpcCallUploadFile |
754 | b6eee126 | Petr Pudlak | prepareRpcCallUploadFile re path = do |
755 | b6eee126 | Petr Pudlak | status <- liftIO $ getFileStatus path |
756 | b6eee126 | Petr Pudlak | content <- liftIO $ BL.readFile path |
757 | b6eee126 | Petr Pudlak | let lookupM x m = maybe (failError $ "Uid/gid " ++ show x ++ |
758 | b6eee126 | Petr Pudlak | " not found, probably file " ++ |
759 | b6eee126 | Petr Pudlak | show path ++ " isn't a Ganeti file") |
760 | b6eee126 | Petr Pudlak | return |
761 | b6eee126 | Petr Pudlak | (Map.lookup x m) |
762 | b6eee126 | Petr Pudlak | uid <- lookupM (fileOwner status) (reUidToUser re) |
763 | b6eee126 | Petr Pudlak | gid <- lookupM (fileGroup status) (reGidToGroup re) |
764 | b6eee126 | Petr Pudlak | vpath <- liftIO $ makeVirtualPath path |
765 | b6eee126 | Petr Pudlak | return $ RpcCallUploadFile |
766 | b6eee126 | Petr Pudlak | vpath |
767 | b6eee126 | Petr Pudlak | (packCompressed content) |
768 | b6eee126 | Petr Pudlak | (Just $ fileMode status) |
769 | b6eee126 | Petr Pudlak | uid |
770 | b6eee126 | Petr Pudlak | gid |
771 | b6eee126 | Petr Pudlak | (cTimeToClockTime $ accessTime status) |
772 | b6eee126 | Petr Pudlak | (cTimeToClockTime $ modificationTime status) |
773 | 9a8952e0 | Petr Pudlak | |
774 | 9a8952e0 | Petr Pudlak | -- | Upload ssconf files to nodes |
775 | 9a8952e0 | Petr Pudlak | |
776 | 9a8952e0 | Petr Pudlak | $(buildObject "RpcCallWriteSsconfFiles" "rpcCallWriteSsconfFiles" |
777 | 9a8952e0 | Petr Pudlak | [ simpleField "values" [t| SSConf |] |
778 | 9a8952e0 | Petr Pudlak | ]) |
779 | 9a8952e0 | Petr Pudlak | |
780 | 9a8952e0 | Petr Pudlak | instance RpcCall RpcCallWriteSsconfFiles where |
781 | 9a8952e0 | Petr Pudlak | rpcCallName _ = "write_ssconf_files" |
782 | 9a8952e0 | Petr Pudlak | rpcCallTimeout _ = rpcTimeoutToRaw Fast |
783 | 9a8952e0 | Petr Pudlak | rpcCallAcceptOffline _ = False |
784 | 9a8952e0 | Petr Pudlak | |
785 | 9a8952e0 | Petr Pudlak | $(buildObject "RpcResultWriteSsconfFiles" "rpcResultWriteSsconfFiles" []) |
786 | 9a8952e0 | Petr Pudlak | |
787 | 9a8952e0 | Petr Pudlak | instance Rpc RpcCallWriteSsconfFiles RpcResultWriteSsconfFiles where |
788 | 9a8952e0 | Petr Pudlak | rpcResultFill _ res = |
789 | 9a8952e0 | Petr Pudlak | case res of |
790 | 9a8952e0 | Petr Pudlak | J.JSNull -> Right RpcResultWriteSsconfFiles |
791 | 9a8952e0 | Petr Pudlak | _ -> Left $ JsonDecodeError |
792 | 9a8952e0 | Petr Pudlak | ("Expected JSNull, got " ++ show (pp_value res)) |