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