| 44 |
44 |
|
| 45 |
45 |
, rpcResultFill
|
| 46 |
46 |
|
|
47 |
, Compressed
|
|
48 |
, packCompressed
|
|
49 |
, toCompressed
|
|
50 |
, getCompressed
|
|
51 |
|
| 47 |
52 |
, RpcCallInstanceInfo(..)
|
| 48 |
53 |
, InstanceState(..)
|
| 49 |
54 |
, InstanceInfo(..)
|
| ... | ... | |
| 84 |
89 |
) where
|
| 85 |
90 |
|
| 86 |
91 |
import Control.Arrow (second)
|
| 87 |
|
import qualified Codec.Compression.Zlib as Zlib
|
|
92 |
import Control.Monad
|
| 88 |
93 |
import qualified Data.ByteString.Lazy.Char8 as BL
|
| 89 |
94 |
import qualified Data.Map as Map
|
| 90 |
95 |
import Data.Maybe (fromMaybe, mapMaybe)
|
| ... | ... | |
| 98 |
103 |
|
| 99 |
104 |
import Ganeti.BasicTypes
|
| 100 |
105 |
import qualified Ganeti.Constants as C
|
|
106 |
import Ganeti.Codec
|
|
107 |
import Ganeti.Curl.Multi
|
| 101 |
108 |
import Ganeti.JSON
|
| 102 |
109 |
import Ganeti.Logging
|
| 103 |
110 |
import Ganeti.Objects
|
| 104 |
111 |
import Ganeti.THH
|
| 105 |
112 |
import Ganeti.THH.Field
|
| 106 |
113 |
import Ganeti.Types
|
| 107 |
|
import Ganeti.Curl.Multi
|
| 108 |
114 |
import Ganeti.Utils
|
| 109 |
115 |
|
| 110 |
116 |
-- * Base RPC functionality and types
|
| ... | ... | |
| 295 |
301 |
fromJSValueToRes :: (J.JSON a) => J.JSValue -> (a -> b) -> ERpcError b
|
| 296 |
302 |
fromJSValueToRes val = fromJResultToRes (J.readJSON val)
|
| 297 |
303 |
|
|
304 |
-- | An opaque data type for representing data that should be compressed
|
|
305 |
-- over the wire.
|
|
306 |
--
|
|
307 |
-- On Python side it is decompressed by @backend._Decompress@.
|
|
308 |
newtype Compressed = Compressed { getCompressed :: BL.ByteString }
|
|
309 |
deriving (Eq, Ord, Show)
|
|
310 |
|
|
311 |
-- TODO Add a unit test for all octets
|
|
312 |
instance J.JSON Compressed where
|
|
313 |
showJSON = J.showJSON
|
|
314 |
. (,) C.rpcEncodingZlibBase64
|
|
315 |
. Base64.encode . compressZlib . getCompressed
|
|
316 |
readJSON = J.readJSON >=> decompress
|
|
317 |
where
|
|
318 |
decompress (enc, cont)
|
|
319 |
| enc == C.rpcEncodingNone =
|
|
320 |
return $ Compressed cont
|
|
321 |
| enc == C.rpcEncodingZlibBase64 =
|
|
322 |
liftM Compressed
|
|
323 |
. either fail return . decompressZlib
|
|
324 |
<=< either (fail . ("Base64: " ++)) return . Base64.decode
|
|
325 |
$ cont
|
|
326 |
| otherwise =
|
|
327 |
fail $ "Unknown RPC encoding type: " ++ show enc
|
|
328 |
|
|
329 |
packCompressed :: BL.ByteString -> Compressed
|
|
330 |
packCompressed = Compressed
|
|
331 |
|
|
332 |
toCompressed :: String -> Compressed
|
|
333 |
toCompressed = packCompressed . BL.pack
|
|
334 |
|
| 298 |
335 |
-- * RPC calls and results
|
| 299 |
336 |
|
| 300 |
337 |
-- ** Instance info
|
| ... | ... | |
| 594 |
631 |
rpcCallAcceptOffline _ = False
|
| 595 |
632 |
rpcCallData _ call = J.encode
|
| 596 |
633 |
( rpcCallJobqueueUpdateFileName call
|
| 597 |
|
, ( C.rpcEncodingZlibBase64
|
| 598 |
|
, BL.unpack . Base64.encode . Zlib.compress . BL.pack
|
| 599 |
|
$ rpcCallJobqueueUpdateContent call
|
| 600 |
|
)
|
|
634 |
, toCompressed $ rpcCallJobqueueUpdateContent call
|
| 601 |
635 |
)
|
| 602 |
636 |
|
| 603 |
637 |
instance Rpc RpcCallJobqueueUpdate RpcResultJobQueueUpdate where
|