Revision d6f05205 src/Ganeti/Rpc.hs
| b/src/Ganeti/Rpc.hs | ||
|---|---|---|
| 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 |
Also available in: Unified diff