Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Rpc.hs @ 79731e21

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