Statistics
| Branch: | Tag: | Revision:

root / src / Ganeti / Rpc.hs @ 835050f3

History | View | Annotate | Download (19.3 kB)

1
{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies,
2
  BangPatterns, TemplateHaskell #-}
3

    
4
{-| Implementation of the RPC client.
5

    
6
-}
7

    
8
{-
9

    
10
Copyright (C) 2012, 2013 Google Inc.
11

    
12
This program is free software; you can redistribute it and/or modify
13
it under the terms of the GNU General Public License as published by
14
the Free Software Foundation; either version 2 of the License, or
15
(at your option) any later version.
16

    
17
This program is distributed in the hope that it will be useful, but
18
WITHOUT ANY WARRANTY; without even the implied warranty of
19
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
20
General Public License for more details.
21

    
22
You should have received a copy of the GNU General Public License
23
along with this program; if not, write to the Free Software
24
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
25
02110-1301, USA.
26

    
27
-}
28

    
29
module Ganeti.Rpc
30
  ( RpcCall
31
  , Rpc
32
  , RpcError(..)
33
  , ERpcError
34
  , explainRpcError
35
  , executeRpcCall
36
  , executeRpcCalls
37
  , logRpcErrors
38

    
39
  , rpcCallName
40
  , rpcCallTimeout
41
  , rpcCallData
42
  , rpcCallAcceptOffline
43

    
44
  , rpcResultFill
45

    
46
  , RpcCallInstanceInfo(..)
47
  , InstanceState(..)
48
  , InstanceInfo(..)
49
  , RpcResultInstanceInfo(..)
50

    
51
  , RpcCallAllInstancesInfo(..)
52
  , RpcResultAllInstancesInfo(..)
53

    
54
  , InstanceConsoleInfoParams(..)
55
  , InstanceConsoleInfo(..)
56
  , RpcCallInstanceConsoleInfo(..)
57
  , RpcResultInstanceConsoleInfo(..)
58

    
59
  , RpcCallInstanceList(..)
60
  , RpcResultInstanceList(..)
61

    
62
  , HvInfo(..)
63
  , StorageInfo(..)
64
  , RpcCallNodeInfo(..)
65
  , RpcResultNodeInfo(..)
66

    
67
  , RpcCallVersion(..)
68
  , RpcResultVersion(..)
69

    
70
  , RpcCallStorageList(..)
71
  , RpcResultStorageList(..)
72

    
73
  , RpcCallTestDelay(..)
74
  , RpcResultTestDelay(..)
75

    
76
  , RpcCallExportList(..)
77
  , RpcResultExportList(..)
78

    
79
  , RpcCallJobqueueUpdate(..)
80
  ) where
81

    
82
import Control.Arrow (second)
83
import qualified Codec.Compression.Zlib as Zlib
84
import qualified Data.ByteString.Lazy.Char8 as BL
85
import qualified Data.Map as Map
86
import Data.Maybe (fromMaybe)
87
import qualified Text.JSON as J
88
import Text.JSON.Pretty (pp_value)
89
import qualified Data.ByteString.Base64.Lazy as Base64
90

    
91
import Network.Curl hiding (content)
92
import qualified Ganeti.Path as P
93

    
94
import Ganeti.BasicTypes
95
import qualified Ganeti.Constants as C
96
import Ganeti.JSON
97
import Ganeti.Logging
98
import Ganeti.Objects
99
import Ganeti.THH
100
import Ganeti.Types
101
import Ganeti.Curl.Multi
102
import Ganeti.Utils
103

    
104
-- * Base RPC functionality and types
105

    
106
-- | The curl options used for RPC.
107
curlOpts :: [CurlOption]
108
curlOpts = [ CurlFollowLocation False
109
           , CurlSSLVerifyHost 0
110
           , CurlSSLVerifyPeer True
111
           , CurlSSLCertType "PEM"
112
           , CurlSSLKeyType "PEM"
113
           , CurlConnectTimeout (fromIntegral C.rpcConnectTimeout)
114
           ]
115

    
116
-- | Data type for RPC error reporting.
117
data RpcError
118
  = CurlLayerError String
119
  | JsonDecodeError String
120
  | RpcResultError String
121
  | OfflineNodeError
122
  deriving (Show, Eq)
123

    
124
-- | Provide explanation to RPC errors.
125
explainRpcError :: RpcError -> String
126
explainRpcError (CurlLayerError code) =
127
    "Curl error:" ++ code
128
explainRpcError (JsonDecodeError msg) =
129
    "Error while decoding JSON from HTTP response: " ++ msg
130
explainRpcError (RpcResultError msg) =
131
    "Error reponse received from RPC server: " ++ msg
132
explainRpcError OfflineNodeError =
133
    "Node is marked offline"
134

    
135
type ERpcError = Either RpcError
136

    
137
-- | A generic class for RPC calls.
138
class (J.JSON a) => RpcCall a where
139
  -- | Give the (Python) name of the procedure.
140
  rpcCallName :: a -> String
141
  -- | Calculate the timeout value for the call execution.
142
  rpcCallTimeout :: a -> Int
143
  -- | Prepare arguments of the call to be send as POST.
144
  rpcCallData :: Node -> a -> String
145
  -- | Whether we accept offline nodes when making a call.
146
  rpcCallAcceptOffline :: a -> Bool
147

    
148
-- | Generic class that ensures matching RPC call with its respective
149
-- result.
150
class (RpcCall a, J.JSON b) => Rpc a b  | a -> b, b -> a where
151
  -- | Create a result based on the received HTTP response.
152
  rpcResultFill :: a -> J.JSValue -> ERpcError b
153

    
154
-- | Http Request definition.
155
data HttpClientRequest = HttpClientRequest
156
  { requestUrl  :: String       -- ^ The actual URL for the node endpoint
157
  , requestData :: String       -- ^ The arguments for the call
158
  , requestOpts :: [CurlOption] -- ^ The various curl options
159
  }
160

    
161
-- | Prepare url for the HTTP request.
162
prepareUrl :: (RpcCall a) => Node -> a -> String
163
prepareUrl node call =
164
  let node_ip = nodePrimaryIp node
165
      port = C.defaultNodedPort
166
      path_prefix = "https://" ++ node_ip ++ ":" ++ show port
167
  in path_prefix ++ "/" ++ rpcCallName call
168

    
169
-- | Create HTTP request for a given node provided it is online,
170
-- otherwise create empty response.
171
prepareHttpRequest :: (RpcCall a) => [CurlOption] -> Node -> a
172
                   -> ERpcError HttpClientRequest
173
prepareHttpRequest opts node call
174
  | rpcCallAcceptOffline call || not (nodeOffline node) =
175
      Right HttpClientRequest { requestUrl  = prepareUrl node call
176
                              , requestData = rpcCallData node call
177
                              , requestOpts = opts ++ curlOpts
178
                              }
179
  | otherwise = Left OfflineNodeError
180

    
181
-- | Parse an HTTP reply.
182
parseHttpReply :: (Rpc a b) =>
183
                  a -> ERpcError (CurlCode, String) -> ERpcError b
184
parseHttpReply _ (Left e) = Left e
185
parseHttpReply call (Right (CurlOK, body)) = parseHttpResponse call body
186
parseHttpReply _ (Right (code, err)) =
187
  Left . CurlLayerError $ "code: " ++ show code ++ ", explanation: " ++ err
188

    
189
-- | Parse a result based on the received HTTP response.
190
parseHttpResponse :: (Rpc a b) => a -> String -> ERpcError b
191
parseHttpResponse call res =
192
  case J.decode res of
193
    J.Error val -> Left $ JsonDecodeError val
194
    J.Ok (True, res'') -> rpcResultFill call res''
195
    J.Ok (False, jerr) -> case jerr of
196
       J.JSString msg -> Left $ RpcResultError (J.fromJSString msg)
197
       _ -> Left . JsonDecodeError $ show (pp_value jerr)
198

    
199
-- | Scan the list of results produced by executeRpcCall and log all the RPC
200
-- errors.
201
logRpcErrors :: [(a, ERpcError b)] -> IO ()
202
logRpcErrors allElems =
203
  let logOneRpcErr (_, Right _) = return ()
204
      logOneRpcErr (_, Left err) =
205
        logError $ "Error in the RPC HTTP reply: " ++ show err
206
  in mapM_ logOneRpcErr allElems
207

    
208
-- | Get options for RPC call
209
getOptionsForCall :: (Rpc a b) => FilePath -> a -> [CurlOption]
210
getOptionsForCall certPath call =
211
  [ CurlTimeout (fromIntegral $ rpcCallTimeout call)
212
  , CurlSSLCert certPath
213
  , CurlSSLKey certPath
214
  , CurlCAInfo certPath
215
  ]
216

    
217
-- | Execute multiple RPC calls in parallel
218
executeRpcCalls :: (Rpc a b) => [(Node, a)] -> IO [(Node, ERpcError b)]
219
executeRpcCalls nodeCalls = do
220
  cert_file <- P.nodedCertFile
221
  let (nodes, calls) = unzip nodeCalls
222
      opts = map (getOptionsForCall cert_file) calls
223
      opts_urls = zipWith3 (\n c o ->
224
                         case prepareHttpRequest o n c of
225
                           Left v -> Left v
226
                           Right request ->
227
                             Right (CurlPostFields [requestData request]:
228
                                    requestOpts request,
229
                                    requestUrl request)
230
                    ) nodes calls opts
231
  -- split the opts_urls list; we don't want to pass the
232
  -- failed-already nodes to Curl
233
  let (lefts, rights, trail) = splitEithers opts_urls
234
  results <- execMultiCall rights
235
  results' <- case recombineEithers lefts results trail of
236
                Bad msg -> error msg
237
                Ok r -> return r
238
  -- now parse the replies
239
  let results'' = zipWith parseHttpReply calls results'
240
      pairedList = zip nodes results''
241
  logRpcErrors pairedList
242
  return pairedList
243

    
244
-- | Execute an RPC call for many nodes in parallel.
245
executeRpcCall :: (Rpc a b) => [Node] -> a -> IO [(Node, ERpcError b)]
246
executeRpcCall nodes call = executeRpcCalls . zip nodes $ repeat call
247

    
248
-- | Helper function that is used to read dictionaries of values.
249
sanitizeDictResults :: [(String, J.Result a)] -> ERpcError [(String, a)]
250
sanitizeDictResults =
251
  foldr sanitize1 (Right [])
252
  where
253
    sanitize1 _ (Left e) = Left e
254
    sanitize1 (_, J.Error e) _ = Left $ JsonDecodeError e
255
    sanitize1 (name, J.Ok v) (Right res) = Right $ (name, v) : res
256

    
257
-- | Helper function to tranform JSON Result to Either RpcError b.
258
-- Note: For now we really only use it for b s.t. Rpc c b for some c
259
fromJResultToRes :: J.Result a -> (a -> b) -> ERpcError b
260
fromJResultToRes (J.Error v) _ = Left $ JsonDecodeError v
261
fromJResultToRes (J.Ok v) f = Right $ f v
262

    
263
-- | Helper function transforming JSValue to Rpc result type.
264
fromJSValueToRes :: (J.JSON a) => J.JSValue -> (a -> b) -> ERpcError b
265
fromJSValueToRes val = fromJResultToRes (J.readJSON val)
266

    
267
-- * RPC calls and results
268

    
269
-- ** Instance info
270

    
271
-- | Returns information about a single instance
272
$(buildObject "RpcCallInstanceInfo" "rpcCallInstInfo"
273
  [ simpleField "instance" [t| String |]
274
  , simpleField "hname" [t| Hypervisor |]
275
  ])
276

    
277
$(declareILADT "InstanceState"
278
  [ ("InstanceStateRunning", 0)
279
  , ("InstanceStateShutdown", 1)
280
  ])
281

    
282
$(makeJSONInstance ''InstanceState)
283

    
284
instance PyValue InstanceState where
285
  showValue = show . instanceStateToRaw
286

    
287
$(buildObject "InstanceInfo" "instInfo"
288
  [ simpleField "memory" [t| Int|]
289
  , simpleField "state"  [t| InstanceState |]
290
  , simpleField "vcpus"  [t| Int |]
291
  , simpleField "time"   [t| Int |]
292
  ])
293

    
294
-- This is optional here because the result may be empty if instance is
295
-- not on a node - and this is not considered an error.
296
$(buildObject "RpcResultInstanceInfo" "rpcResInstInfo"
297
  [ optionalField $ simpleField "inst_info" [t| InstanceInfo |]])
298

    
299
instance RpcCall RpcCallInstanceInfo where
300
  rpcCallName _          = "instance_info"
301
  rpcCallTimeout _       = rpcTimeoutToRaw Urgent
302
  rpcCallAcceptOffline _ = False
303
  rpcCallData _ call     = J.encode
304
    ( rpcCallInstInfoInstance call
305
    , rpcCallInstInfoHname call
306
    )
307

    
308
instance Rpc RpcCallInstanceInfo RpcResultInstanceInfo where
309
  rpcResultFill _ res =
310
    case res of
311
      J.JSObject res' ->
312
        case J.fromJSObject res' of
313
          [] -> Right $ RpcResultInstanceInfo Nothing
314
          _ -> fromJSValueToRes res (RpcResultInstanceInfo . Just)
315
      _ -> Left $ JsonDecodeError
316
           ("Expected JSObject, got " ++ show (pp_value res))
317

    
318
-- ** AllInstancesInfo
319

    
320
-- | Returns information about all running instances on the given nodes
321
$(buildObject "RpcCallAllInstancesInfo" "rpcCallAllInstInfo"
322
  [ simpleField "hypervisors" [t| [(Hypervisor, HvParams)] |] ])
323

    
324
$(buildObject "RpcResultAllInstancesInfo" "rpcResAllInstInfo"
325
  [ simpleField "instances" [t| [(String, InstanceInfo)] |] ])
326

    
327
instance RpcCall RpcCallAllInstancesInfo where
328
  rpcCallName _          = "all_instances_info"
329
  rpcCallTimeout _       = rpcTimeoutToRaw Urgent
330
  rpcCallAcceptOffline _ = False
331
  rpcCallData _ call     = J.encode (
332
    map fst $ rpcCallAllInstInfoHypervisors call,
333
    GenericContainer . Map.fromList $ rpcCallAllInstInfoHypervisors call)
334

    
335
instance Rpc RpcCallAllInstancesInfo RpcResultAllInstancesInfo where
336
  -- FIXME: Is there a simpler way to do it?
337
  rpcResultFill _ res =
338
    case res of
339
      J.JSObject res' ->
340
        let res'' = map (second J.readJSON) (J.fromJSObject res')
341
                        :: [(String, J.Result InstanceInfo)] in
342
        case sanitizeDictResults res'' of
343
          Left err -> Left err
344
          Right insts -> Right $ RpcResultAllInstancesInfo insts
345
      _ -> Left $ JsonDecodeError
346
           ("Expected JSObject, got " ++ show (pp_value res))
347

    
348
-- ** InstanceConsoleInfo
349

    
350
-- | Returns information about how to access instances on the given node
351
$(buildObject "InstanceConsoleInfoParams" "instConsInfoParams"
352
  [ simpleField "instance"    [t| Instance |]
353
  , simpleField "node"        [t| Node |]
354
  , simpleField "group"       [t| NodeGroup |]
355
  , simpleField "hvParams"    [t| HvParams |]
356
  , simpleField "beParams"    [t| FilledBeParams |]
357
  ])
358

    
359
$(buildObject "RpcCallInstanceConsoleInfo" "rpcCallInstConsInfo"
360
  [ simpleField "instanceInfo" [t| [(String, InstanceConsoleInfoParams)] |] ])
361

    
362
$(buildObject "InstanceConsoleInfo" "instConsInfo"
363
  [ simpleField "instance"    [t| String |]
364
  , simpleField "kind"        [t| String |]
365
  , optionalField $
366
    simpleField "message"     [t| String |]
367
  , optionalField $
368
    simpleField "host"        [t| String |]
369
  , optionalField $
370
    simpleField "port"        [t| Int |]
371
  , optionalField $
372
    simpleField "user"        [t| String |]
373
  , optionalField $
374
    simpleField "command"     [t| [String] |]
375
  , optionalField $
376
    simpleField "display"     [t| String |]
377
  ])
378

    
379
$(buildObject "RpcResultInstanceConsoleInfo" "rpcResInstConsInfo"
380
  [ simpleField "instancesInfo" [t| [(String, InstanceConsoleInfo)] |] ])
381

    
382
instance RpcCall RpcCallInstanceConsoleInfo where
383
  rpcCallName _          = "instance_console_info"
384
  rpcCallTimeout _       = rpcTimeoutToRaw Urgent
385
  rpcCallAcceptOffline _ = False
386
  rpcCallData _ call     = J.encode .
387
    GenericContainer $ Map.fromList (rpcCallInstConsInfoInstanceInfo call)
388

    
389
instance Rpc RpcCallInstanceConsoleInfo RpcResultInstanceConsoleInfo where
390
  rpcResultFill _ res =
391
    case res of
392
      J.JSObject res' ->
393
        let res'' = map (second J.readJSON) (J.fromJSObject res')
394
                        :: [(String, J.Result InstanceConsoleInfo)] in
395
        case sanitizeDictResults res'' of
396
          Left err -> Left err
397
          Right instInfos -> Right $ RpcResultInstanceConsoleInfo instInfos
398
      _ -> Left $ JsonDecodeError
399
           ("Expected JSObject, got " ++ show (pp_value res))
400

    
401
-- ** InstanceList
402

    
403
-- | Returns the list of running instances on the given nodes
404
$(buildObject "RpcCallInstanceList" "rpcCallInstList"
405
  [ simpleField "hypervisors" [t| [Hypervisor] |] ])
406

    
407
$(buildObject "RpcResultInstanceList" "rpcResInstList"
408
  [ simpleField "instances" [t| [String] |] ])
409

    
410
instance RpcCall RpcCallInstanceList where
411
  rpcCallName _          = "instance_list"
412
  rpcCallTimeout _       = rpcTimeoutToRaw Urgent
413
  rpcCallAcceptOffline _ = False
414
  rpcCallData _ call     = J.encode [rpcCallInstListHypervisors call]
415

    
416
instance Rpc RpcCallInstanceList RpcResultInstanceList where
417
  rpcResultFill _ res = fromJSValueToRes res RpcResultInstanceList
418

    
419
-- ** NodeInfo
420

    
421
-- | Returns node information
422
$(buildObject "RpcCallNodeInfo" "rpcCallNodeInfo"
423
  [ simpleField "storage_units" [t| Map.Map String [StorageUnit] |]
424
  , simpleField "hypervisors" [t| [ (Hypervisor, HvParams) ] |]
425
  ])
426

    
427
$(buildObject "StorageInfo" "storageInfo"
428
  [ simpleField "name" [t| String |]
429
  , simpleField "type" [t| String |]
430
  , optionalField $ simpleField "storage_free" [t| Int |]
431
  , optionalField $ simpleField "storage_size" [t| Int |]
432
  ])
433

    
434
-- | We only provide common fields as described in hv_base.py.
435
$(buildObject "HvInfo" "hvInfo"
436
  [ simpleField "memory_total" [t| Int |]
437
  , simpleField "memory_free" [t| Int |]
438
  , simpleField "memory_dom0" [t| Int |]
439
  , simpleField "cpu_total" [t| Int |]
440
  , simpleField "cpu_nodes" [t| Int |]
441
  , simpleField "cpu_sockets" [t| Int |]
442
  , simpleField "cpu_dom0" [t| Int |]
443
  ])
444

    
445
$(buildObject "RpcResultNodeInfo" "rpcResNodeInfo"
446
  [ simpleField "boot_id" [t| String |]
447
  , simpleField "storage_info" [t| [StorageInfo] |]
448
  , simpleField "hv_info" [t| [HvInfo] |]
449
  ])
450

    
451
instance RpcCall RpcCallNodeInfo where
452
  rpcCallName _          = "node_info"
453
  rpcCallTimeout _       = rpcTimeoutToRaw Urgent
454
  rpcCallAcceptOffline _ = False
455
  rpcCallData n call     = J.encode
456
    ( fromMaybe (error $ "Programmer error: missing parameter for node named "
457
                         ++ nodeName n)
458
          $ Map.lookup (nodeUuid n) (rpcCallNodeInfoStorageUnits call)
459
    , rpcCallNodeInfoHypervisors call
460
    )
461

    
462
instance Rpc RpcCallNodeInfo RpcResultNodeInfo where
463
  rpcResultFill _ res =
464
    fromJSValueToRes res (\(b, vg, hv) -> RpcResultNodeInfo b vg hv)
465

    
466
-- ** Version
467

    
468
-- | Query node version.
469
$(buildObject "RpcCallVersion" "rpcCallVersion" [])
470

    
471
-- | Query node reply.
472
$(buildObject "RpcResultVersion" "rpcResultVersion"
473
  [ simpleField "version" [t| Int |]
474
  ])
475

    
476
instance RpcCall RpcCallVersion where
477
  rpcCallName _          = "version"
478
  rpcCallTimeout _       = rpcTimeoutToRaw Urgent
479
  rpcCallAcceptOffline _ = True
480
  rpcCallData _          = J.encode
481

    
482
instance Rpc RpcCallVersion RpcResultVersion where
483
  rpcResultFill _ res = fromJSValueToRes res RpcResultVersion
484

    
485
-- ** StorageList
486

    
487
$(buildObject "RpcCallStorageList" "rpcCallStorageList"
488
  [ simpleField "su_name" [t| StorageType |]
489
  , simpleField "su_args" [t| [String] |]
490
  , simpleField "name"    [t| String |]
491
  , simpleField "fields"  [t| [StorageField] |]
492
  ])
493

    
494
-- FIXME: The resulting JSValues should have types appropriate for their
495
-- StorageField value: Used -> Bool, Name -> String etc
496
$(buildObject "RpcResultStorageList" "rpcResStorageList"
497
  [ simpleField "storage" [t| [[(StorageField, J.JSValue)]] |] ])
498

    
499
instance RpcCall RpcCallStorageList where
500
  rpcCallName _          = "storage_list"
501
  rpcCallTimeout _       = rpcTimeoutToRaw Normal
502
  rpcCallAcceptOffline _ = False
503
  rpcCallData _ call     = J.encode
504
    ( rpcCallStorageListSuName call
505
    , rpcCallStorageListSuArgs call
506
    , rpcCallStorageListName call
507
    , rpcCallStorageListFields call
508
    )
509

    
510
instance Rpc RpcCallStorageList RpcResultStorageList where
511
  rpcResultFill call res =
512
    let sfields = rpcCallStorageListFields call in
513
    fromJSValueToRes res (RpcResultStorageList . map (zip sfields))
514

    
515
-- ** TestDelay
516

    
517
-- | Call definition for test delay.
518
$(buildObject "RpcCallTestDelay" "rpcCallTestDelay"
519
  [ simpleField "duration" [t| Double |]
520
  ])
521

    
522
-- | Result definition for test delay.
523
data RpcResultTestDelay = RpcResultTestDelay
524
                          deriving Show
525

    
526
-- | Custom JSON instance for null result.
527
instance J.JSON RpcResultTestDelay where
528
  showJSON _        = J.JSNull
529
  readJSON J.JSNull = return RpcResultTestDelay
530
  readJSON _        = fail "Unable to read RpcResultTestDelay"
531

    
532
instance RpcCall RpcCallTestDelay where
533
  rpcCallName _          = "test_delay"
534
  rpcCallTimeout         = ceiling . (+ 5) . rpcCallTestDelayDuration
535
  rpcCallAcceptOffline _ = False
536
  rpcCallData _ call     = J.encode [rpcCallTestDelayDuration call]
537

    
538
instance Rpc RpcCallTestDelay RpcResultTestDelay where
539
  rpcResultFill _ res = fromJSValueToRes res id
540

    
541
-- ** ExportList
542

    
543
-- | Call definition for export list.
544

    
545
$(buildObject "RpcCallExportList" "rpcCallExportList" [])
546

    
547
-- | Result definition for export list.
548
$(buildObject "RpcResultExportList" "rpcResExportList"
549
  [ simpleField "exports" [t| [String] |]
550
  ])
551

    
552
instance RpcCall RpcCallExportList where
553
  rpcCallName _          = "export_list"
554
  rpcCallTimeout _       = rpcTimeoutToRaw Fast
555
  rpcCallAcceptOffline _ = False
556
  rpcCallData _          = J.encode
557

    
558
instance Rpc RpcCallExportList RpcResultExportList where
559
  rpcResultFill _ res = fromJSValueToRes res RpcResultExportList
560

    
561
-- ** Job Queue Replication
562
  
563
-- | Update a job queue file
564
  
565
$(buildObject "RpcCallJobqueueUpdate" "rpcCallJobqueueUpdate"
566
  [ simpleField "file_name" [t| String |]
567
  , simpleField "content" [t| String |]
568
  ])
569

    
570
instance RpcCall RpcCallJobqueueUpdate where
571
  rpcCallName _          = "jobqueue_update"
572
  rpcCallTimeout _       = rpcTimeoutToRaw Fast
573
  rpcCallAcceptOffline _ = False
574
  rpcCallData _ call     = J.encode
575
    ( rpcCallJobqueueUpdateFileName call
576
    , ( C.rpcEncodingZlibBase64
577
      , BL.unpack . Base64.encode . Zlib.compress . BL.pack
578
          $ rpcCallJobqueueUpdateContent call
579
      )
580
    )
581

    
582
instance Rpc RpcCallJobqueueUpdate () where
583
  rpcResultFill _ res =
584
    case res of
585
      J.JSNull ->  Right ()
586
      _ -> Left $ JsonDecodeError
587
           ("Expected JSNull, got " ++ show (pp_value res))
588