root / htools / Ganeti / Rpc.hs @ 599239ad
History | View | Annotate | Download (9.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 | , RpcResult |
32 | d4709cce | Agata Murawska | , Rpc |
33 | d4709cce | Agata Murawska | , RpcError(..) |
34 | 599239ad | Agata Murawska | , ERpcError |
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 | 96dad12d | Agata Murawska | , RpcCallAllInstancesInfo(..) |
46 | 96dad12d | Agata Murawska | , RpcResultAllInstancesInfo(..) |
47 | 96dad12d | Agata Murawska | |
48 | c1c5aab1 | Agata Murawska | , RpcCallInstanceList(..) |
49 | c1c5aab1 | Agata Murawska | , RpcResultInstanceList(..) |
50 | c1c5aab1 | Agata Murawska | |
51 | dc623a95 | Agata Murawska | , HvInfo(..) |
52 | dc623a95 | Agata Murawska | , VgInfo(..) |
53 | dc623a95 | Agata Murawska | , RpcCallNodeInfo(..) |
54 | dc623a95 | Agata Murawska | , RpcResultNodeInfo(..) |
55 | dc623a95 | Agata Murawska | |
56 | 96dad12d | Agata Murawska | , rpcTimeoutFromRaw -- FIXME: Not used anywhere |
57 | d4709cce | Agata Murawska | ) where |
58 | d4709cce | Agata Murawska | |
59 | d4709cce | Agata Murawska | import qualified Text.JSON as J |
60 | 96dad12d | Agata Murawska | import Text.JSON (makeObj) |
61 | d4709cce | Agata Murawska | |
62 | eaed5f19 | Agata Murawska | #ifndef NO_CURL |
63 | eaed5f19 | Agata Murawska | import Network.Curl |
64 | 7766de33 | Agata Murawska | import qualified Ganeti.Path as P |
65 | eaed5f19 | Agata Murawska | #endif |
66 | eaed5f19 | Agata Murawska | |
67 | eaed5f19 | Agata Murawska | import qualified Ganeti.Constants as C |
68 | d4709cce | Agata Murawska | import Ganeti.Objects |
69 | 96dad12d | Agata Murawska | import Ganeti.THH |
70 | f3baf5ef | Iustin Pop | import Ganeti.Compat |
71 | f3baf5ef | Iustin Pop | import Ganeti.JSON |
72 | eaed5f19 | Agata Murawska | |
73 | eaed5f19 | Agata Murawska | #ifndef NO_CURL |
74 | eaed5f19 | Agata Murawska | -- | The curl options used for RPC. |
75 | eaed5f19 | Agata Murawska | curlOpts :: [CurlOption] |
76 | eaed5f19 | Agata Murawska | curlOpts = [ CurlFollowLocation False |
77 | 7766de33 | Agata Murawska | , CurlCAInfo P.nodedCertFile |
78 | eaed5f19 | Agata Murawska | , CurlSSLVerifyHost 0 |
79 | eaed5f19 | Agata Murawska | , CurlSSLVerifyPeer True |
80 | eaed5f19 | Agata Murawska | , CurlSSLCertType "PEM" |
81 | 7766de33 | Agata Murawska | , CurlSSLCert P.nodedCertFile |
82 | eaed5f19 | Agata Murawska | , CurlSSLKeyType "PEM" |
83 | 7766de33 | Agata Murawska | , CurlSSLKey P.nodedCertFile |
84 | eaed5f19 | Agata Murawska | , CurlConnectTimeout (fromIntegral C.rpcConnectTimeout) |
85 | eaed5f19 | Agata Murawska | ] |
86 | eaed5f19 | Agata Murawska | #endif |
87 | d4709cce | Agata Murawska | |
88 | d4709cce | Agata Murawska | -- | Data type for RPC error reporting. |
89 | d4709cce | Agata Murawska | data RpcError |
90 | d4709cce | Agata Murawska | = CurlDisabledError |
91 | d4709cce | Agata Murawska | | CurlLayerError Node String |
92 | d4709cce | Agata Murawska | | JsonDecodeError String |
93 | 6fddde87 | Agata Murawska | | RpcResultError String |
94 | d4709cce | Agata Murawska | | OfflineNodeError Node |
95 | d4709cce | Agata Murawska | deriving Eq |
96 | d4709cce | Agata Murawska | |
97 | d4709cce | Agata Murawska | instance Show RpcError where |
98 | d4709cce | Agata Murawska | show CurlDisabledError = |
99 | d4709cce | Agata Murawska | "RPC/curl backend disabled at compile time" |
100 | d4709cce | Agata Murawska | show (CurlLayerError node code) = |
101 | 6fddde87 | Agata Murawska | "Curl error for " ++ nodeName node ++ ", " ++ code |
102 | d4709cce | Agata Murawska | show (JsonDecodeError msg) = |
103 | 6fddde87 | Agata Murawska | "Error while decoding JSON from HTTP response: " ++ msg |
104 | 6fddde87 | Agata Murawska | show (RpcResultError msg) = |
105 | 6fddde87 | Agata Murawska | "Error reponse received from RPC server: " ++ msg |
106 | d4709cce | Agata Murawska | show (OfflineNodeError node) = |
107 | d4709cce | Agata Murawska | "Node " ++ nodeName node ++ " is marked as offline" |
108 | d4709cce | Agata Murawska | |
109 | 599239ad | Agata Murawska | type ERpcError = Either RpcError |
110 | 599239ad | Agata Murawska | |
111 | 599239ad | Agata Murawska | rpcErrorJsonReport :: (Monad m) => J.Result a -> m (ERpcError a) |
112 | 2cdaf225 | Iustin Pop | rpcErrorJsonReport (J.Error x) = return . Left $ JsonDecodeError x |
113 | d4709cce | Agata Murawska | rpcErrorJsonReport (J.Ok x) = return $ Right x |
114 | d4709cce | Agata Murawska | |
115 | 96dad12d | Agata Murawska | -- | Basic timeouts for RPC calls. |
116 | 96dad12d | Agata Murawska | $(declareIADT "RpcTimeout" |
117 | 96dad12d | Agata Murawska | [ ( "Urgent", 'C.rpcTmoUrgent ) |
118 | 96dad12d | Agata Murawska | , ( "Fast", 'C.rpcTmoFast ) |
119 | 96dad12d | Agata Murawska | , ( "Normal", 'C.rpcTmoNormal ) |
120 | 96dad12d | Agata Murawska | , ( "Slow", 'C.rpcTmoSlow ) |
121 | 96dad12d | Agata Murawska | , ( "FourHours", 'C.rpcTmo4hrs ) |
122 | 96dad12d | Agata Murawska | , ( "OneDay", 'C.rpcTmo1day ) |
123 | 96dad12d | Agata Murawska | ]) |
124 | 96dad12d | Agata Murawska | |
125 | d4709cce | Agata Murawska | -- | A generic class for RPC calls. |
126 | d4709cce | Agata Murawska | class (J.JSON a) => RpcCall a where |
127 | d4709cce | Agata Murawska | -- | Give the (Python) name of the procedure. |
128 | d4709cce | Agata Murawska | rpcCallName :: a -> String |
129 | d4709cce | Agata Murawska | -- | Calculate the timeout value for the call execution. |
130 | d4709cce | Agata Murawska | rpcCallTimeout :: a -> Int |
131 | d4709cce | Agata Murawska | -- | Prepare arguments of the call to be send as POST. |
132 | d4709cce | Agata Murawska | rpcCallData :: Node -> a -> String |
133 | d4709cce | Agata Murawska | -- | Whether we accept offline nodes when making a call. |
134 | d4709cce | Agata Murawska | rpcCallAcceptOffline :: a -> Bool |
135 | d4709cce | Agata Murawska | |
136 | d4709cce | Agata Murawska | rpcCallData _ = J.encode |
137 | d4709cce | Agata Murawska | |
138 | d4709cce | Agata Murawska | -- | A generic class for RPC results with default implementation. |
139 | d4709cce | Agata Murawska | class (J.JSON a) => RpcResult a where |
140 | d4709cce | Agata Murawska | -- | Create a result based on the received HTTP response. |
141 | 599239ad | Agata Murawska | rpcResultFill :: (Monad m) => String -> m (ERpcError a) |
142 | d4709cce | Agata Murawska | |
143 | d4709cce | Agata Murawska | rpcResultFill res = rpcErrorJsonReport $ J.decode res |
144 | d4709cce | Agata Murawska | |
145 | d4709cce | Agata Murawska | -- | Generic class that ensures matching RPC call with its respective |
146 | d4709cce | Agata Murawska | -- result. |
147 | d4709cce | Agata Murawska | class (RpcCall a, RpcResult b) => Rpc a b | a -> b |
148 | eaed5f19 | Agata Murawska | |
149 | eaed5f19 | Agata Murawska | -- | Http Request definition. |
150 | eaed5f19 | Agata Murawska | data HttpClientRequest = HttpClientRequest |
151 | eaed5f19 | Agata Murawska | { requestTimeout :: Int |
152 | eaed5f19 | Agata Murawska | , requestUrl :: String |
153 | eaed5f19 | Agata Murawska | , requestPostData :: String |
154 | eaed5f19 | Agata Murawska | } |
155 | eaed5f19 | Agata Murawska | |
156 | eaed5f19 | Agata Murawska | -- | Execute the request and return the result as a plain String. When |
157 | eaed5f19 | Agata Murawska | -- curl reports an error, we propagate it. |
158 | 599239ad | Agata Murawska | executeHttpRequest :: Node -> ERpcError HttpClientRequest |
159 | 599239ad | Agata Murawska | -> IO (ERpcError String) |
160 | eaed5f19 | Agata Murawska | |
161 | eaed5f19 | Agata Murawska | executeHttpRequest _ (Left rpc_err) = return $ Left rpc_err |
162 | eaed5f19 | Agata Murawska | #ifdef NO_CURL |
163 | eaed5f19 | Agata Murawska | executeHttpRequest _ _ = return $ Left CurlDisabledError |
164 | eaed5f19 | Agata Murawska | #else |
165 | eaed5f19 | Agata Murawska | executeHttpRequest node (Right request) = do |
166 | eaed5f19 | Agata Murawska | let reqOpts = [ CurlTimeout (fromIntegral $ requestTimeout request) |
167 | eaed5f19 | Agata Murawska | , CurlPostFields [requestPostData request] |
168 | eaed5f19 | Agata Murawska | ] |
169 | eaed5f19 | Agata Murawska | url = requestUrl request |
170 | eaed5f19 | Agata Murawska | -- FIXME: This is very similar to getUrl in Htools/Rapi.hs |
171 | eaed5f19 | Agata Murawska | (code, !body) <- curlGetString url $ curlOpts ++ reqOpts |
172 | 2cdaf225 | Iustin Pop | return $ case code of |
173 | 2cdaf225 | Iustin Pop | CurlOK -> Right body |
174 | 2cdaf225 | Iustin Pop | _ -> Left $ CurlLayerError node (show code) |
175 | eaed5f19 | Agata Murawska | #endif |
176 | eaed5f19 | Agata Murawska | |
177 | eaed5f19 | Agata Murawska | -- | Prepare url for the HTTP request. |
178 | eaed5f19 | Agata Murawska | prepareUrl :: (RpcCall a) => Node -> a -> String |
179 | eaed5f19 | Agata Murawska | prepareUrl node call = |
180 | eaed5f19 | Agata Murawska | let node_ip = nodePrimaryIp node |
181 | eaed5f19 | Agata Murawska | port = snd C.daemonsPortsGanetiNoded |
182 | 5b11f8db | Iustin Pop | path_prefix = "https://" ++ node_ip ++ ":" ++ show port |
183 | 5b11f8db | Iustin Pop | in path_prefix ++ "/" ++ rpcCallName call |
184 | eaed5f19 | Agata Murawska | |
185 | eaed5f19 | Agata Murawska | -- | Create HTTP request for a given node provided it is online, |
186 | eaed5f19 | Agata Murawska | -- otherwise create empty response. |
187 | eaed5f19 | Agata Murawska | prepareHttpRequest :: (RpcCall a) => Node -> a |
188 | 599239ad | Agata Murawska | -> ERpcError HttpClientRequest |
189 | eaed5f19 | Agata Murawska | prepareHttpRequest node call |
190 | 5b11f8db | Iustin Pop | | rpcCallAcceptOffline call || not (nodeOffline node) = |
191 | 5b11f8db | Iustin Pop | Right HttpClientRequest { requestTimeout = rpcCallTimeout call |
192 | 5b11f8db | Iustin Pop | , requestUrl = prepareUrl node call |
193 | 5b11f8db | Iustin Pop | , requestPostData = rpcCallData node call |
194 | 5b11f8db | Iustin Pop | } |
195 | eaed5f19 | Agata Murawska | | otherwise = Left $ OfflineNodeError node |
196 | eaed5f19 | Agata Murawska | |
197 | eaed5f19 | Agata Murawska | -- | Parse the response or propagate the error. |
198 | 599239ad | Agata Murawska | parseHttpResponse :: (Monad m, RpcResult a) => ERpcError String |
199 | 599239ad | Agata Murawska | -> m (ERpcError a) |
200 | eaed5f19 | Agata Murawska | parseHttpResponse (Left err) = return $ Left err |
201 | eaed5f19 | Agata Murawska | parseHttpResponse (Right response) = rpcResultFill response |
202 | eaed5f19 | Agata Murawska | |
203 | eaed5f19 | Agata Murawska | -- | Execute RPC call for a sigle node. |
204 | 599239ad | Agata Murawska | executeSingleRpcCall :: (Rpc a b) => Node -> a -> IO (Node, ERpcError b) |
205 | eaed5f19 | Agata Murawska | executeSingleRpcCall node call = do |
206 | eaed5f19 | Agata Murawska | let request = prepareHttpRequest node call |
207 | eaed5f19 | Agata Murawska | response <- executeHttpRequest node request |
208 | eaed5f19 | Agata Murawska | result <- parseHttpResponse response |
209 | eaed5f19 | Agata Murawska | return (node, result) |
210 | eaed5f19 | Agata Murawska | |
211 | eaed5f19 | Agata Murawska | -- | Execute RPC call for many nodes in parallel. |
212 | 599239ad | Agata Murawska | executeRpcCall :: (Rpc a b) => [Node] -> a -> IO [(Node, ERpcError b)] |
213 | eaed5f19 | Agata Murawska | executeRpcCall nodes call = |
214 | eaed5f19 | Agata Murawska | sequence $ parMap rwhnf (uncurry executeSingleRpcCall) |
215 | eaed5f19 | Agata Murawska | (zip nodes $ repeat call) |
216 | 96dad12d | Agata Murawska | |
217 | 96dad12d | Agata Murawska | -- * RPC calls and results |
218 | 96dad12d | Agata Murawska | |
219 | 96dad12d | Agata Murawska | -- | AllInstancesInfo |
220 | 96dad12d | Agata Murawska | -- Returns information about all instances on the given nodes |
221 | 5b11f8db | Iustin Pop | $(buildObject "RpcCallAllInstancesInfo" "rpcCallAllInstInfo" |
222 | 96dad12d | Agata Murawska | [ simpleField "hypervisors" [t| [Hypervisor] |] ]) |
223 | 96dad12d | Agata Murawska | |
224 | 5b11f8db | Iustin Pop | $(buildObject "InstanceInfo" "instInfo" |
225 | 96dad12d | Agata Murawska | [ simpleField "name" [t| String |] |
226 | 96dad12d | Agata Murawska | , simpleField "memory" [t| Int|] |
227 | 96dad12d | Agata Murawska | , simpleField "state" [t| AdminState |] |
228 | 96dad12d | Agata Murawska | , simpleField "vcpus" [t| Int |] |
229 | 96dad12d | Agata Murawska | , simpleField "time" [t| Int |] |
230 | 96dad12d | Agata Murawska | ]) |
231 | 96dad12d | Agata Murawska | |
232 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultAllInstancesInfo" "rpcResAllInstInfo" |
233 | 96dad12d | Agata Murawska | [ simpleField "instances" [t| [InstanceInfo] |] ]) |
234 | 96dad12d | Agata Murawska | |
235 | 96dad12d | Agata Murawska | instance RpcCall RpcCallAllInstancesInfo where |
236 | 96dad12d | Agata Murawska | rpcCallName _ = "all_instances_info" |
237 | 96dad12d | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
238 | 96dad12d | Agata Murawska | rpcCallAcceptOffline _ = False |
239 | 96dad12d | Agata Murawska | |
240 | 96dad12d | Agata Murawska | instance RpcResult RpcResultAllInstancesInfo |
241 | 96dad12d | Agata Murawska | |
242 | 96dad12d | Agata Murawska | instance Rpc RpcCallAllInstancesInfo RpcResultAllInstancesInfo |
243 | c1c5aab1 | Agata Murawska | |
244 | c1c5aab1 | Agata Murawska | -- | InstanceList |
245 | c1c5aab1 | Agata Murawska | -- Returns the list of running instances on the given nodes. |
246 | 5b11f8db | Iustin Pop | $(buildObject "RpcCallInstanceList" "rpcCallInstList" |
247 | c1c5aab1 | Agata Murawska | [ simpleField "hypervisors" [t| [Hypervisor] |] ]) |
248 | c1c5aab1 | Agata Murawska | |
249 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultInstanceList" "rpcResInstList" |
250 | c1c5aab1 | Agata Murawska | [ simpleField "node" [t| Node |] |
251 | c1c5aab1 | Agata Murawska | , simpleField "instances" [t| [String] |] |
252 | c1c5aab1 | Agata Murawska | ]) |
253 | c1c5aab1 | Agata Murawska | |
254 | c1c5aab1 | Agata Murawska | instance RpcCall RpcCallInstanceList where |
255 | c1c5aab1 | Agata Murawska | rpcCallName _ = "instance_list" |
256 | c1c5aab1 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
257 | c1c5aab1 | Agata Murawska | rpcCallAcceptOffline _ = False |
258 | c1c5aab1 | Agata Murawska | |
259 | c1c5aab1 | Agata Murawska | instance RpcResult RpcResultInstanceList |
260 | c1c5aab1 | Agata Murawska | |
261 | c1c5aab1 | Agata Murawska | instance Rpc RpcCallInstanceList RpcResultInstanceList |
262 | dc623a95 | Agata Murawska | |
263 | dc623a95 | Agata Murawska | -- | NodeInfo |
264 | dc623a95 | Agata Murawska | -- Return node information. |
265 | 5b11f8db | Iustin Pop | $(buildObject "RpcCallNodeInfo" "rpcCallNodeInfo" |
266 | dc623a95 | Agata Murawska | [ simpleField "hypervisors" [t| [Hypervisor] |] |
267 | dc623a95 | Agata Murawska | , simpleField "volume_groups" [t| [String] |] |
268 | dc623a95 | Agata Murawska | ]) |
269 | dc623a95 | Agata Murawska | |
270 | 5b11f8db | Iustin Pop | $(buildObject "VgInfo" "vgInfo" |
271 | dc623a95 | Agata Murawska | [ simpleField "name" [t| String |] |
272 | dc623a95 | Agata Murawska | , simpleField "free" [t| Int |] |
273 | dc623a95 | Agata Murawska | , simpleField "size" [t| Int |] |
274 | dc623a95 | Agata Murawska | ]) |
275 | dc623a95 | Agata Murawska | |
276 | dc623a95 | Agata Murawska | -- | We only provide common fields as described in hv_base.py. |
277 | 5b11f8db | Iustin Pop | $(buildObject "HvInfo" "hvInfo" |
278 | dc623a95 | Agata Murawska | [ simpleField "memory_total" [t| Int |] |
279 | dc623a95 | Agata Murawska | , simpleField "memory_free" [t| Int |] |
280 | dc623a95 | Agata Murawska | , simpleField "memory_dom0" [t| Int |] |
281 | dc623a95 | Agata Murawska | , simpleField "cpu_total" [t| Int |] |
282 | dc623a95 | Agata Murawska | , simpleField "cpu_nodes" [t| Int |] |
283 | dc623a95 | Agata Murawska | , simpleField "cpu_sockets" [t| Int |] |
284 | dc623a95 | Agata Murawska | ]) |
285 | dc623a95 | Agata Murawska | |
286 | 5b11f8db | Iustin Pop | $(buildObject "RpcResultNodeInfo" "rpcResNodeInfo" |
287 | dc623a95 | Agata Murawska | [ simpleField "boot_id" [t| String |] |
288 | dc623a95 | Agata Murawska | , simpleField "vg_info" [t| [VgInfo] |] |
289 | dc623a95 | Agata Murawska | , simpleField "hv_info" [t| [HvInfo] |] |
290 | dc623a95 | Agata Murawska | ]) |
291 | dc623a95 | Agata Murawska | |
292 | dc623a95 | Agata Murawska | instance RpcCall RpcCallNodeInfo where |
293 | dc623a95 | Agata Murawska | rpcCallName _ = "node_info" |
294 | dc623a95 | Agata Murawska | rpcCallTimeout _ = rpcTimeoutToRaw Urgent |
295 | dc623a95 | Agata Murawska | rpcCallAcceptOffline _ = False |
296 | dc623a95 | Agata Murawska | |
297 | dc623a95 | Agata Murawska | instance RpcResult RpcResultNodeInfo |
298 | dc623a95 | Agata Murawska | |
299 | dc623a95 | Agata Murawska | instance Rpc RpcCallNodeInfo RpcResultNodeInfo |