Revision bbe9758d htools/Ganeti/OpCodes.hs
| b/htools/Ganeti/OpCodes.hs | ||
|---|---|---|
| 63 | 63 |
data OpCode = OpTestDelay Double Bool [String] |
| 64 | 64 |
| OpInstanceReplaceDisks String (Maybe String) ReplaceDisksMode |
| 65 | 65 |
[Int] (Maybe String) |
| 66 |
| OpInstanceFailover String Bool |
|
| 67 |
| OpInstanceMigrate String Bool Bool Bool |
|
| 66 |
| OpInstanceFailover String Bool (Maybe String)
|
|
| 67 |
| OpInstanceMigrate String Bool Bool Bool (Maybe String)
|
|
| 68 | 68 |
deriving (Show, Read, Eq) |
| 69 | 69 |
|
| 70 | 70 |
|
| ... | ... | |
| 72 | 72 |
opID :: OpCode -> String |
| 73 | 73 |
opID (OpTestDelay _ _ _) = "OP_TEST_DELAY" |
| 74 | 74 |
opID (OpInstanceReplaceDisks _ _ _ _ _) = "OP_INSTANCE_REPLACE_DISKS" |
| 75 |
opID (OpInstanceFailover _ _) = "OP_INSTANCE_FAILOVER"
|
|
| 76 |
opID (OpInstanceMigrate _ _ _ _) = "OP_INSTANCE_MIGRATE"
|
|
| 75 |
opID (OpInstanceFailover {}) = "OP_INSTANCE_FAILOVER"
|
|
| 76 |
opID (OpInstanceMigrate {}) = "OP_INSTANCE_MIGRATE"
|
|
| 77 | 77 |
|
| 78 | 78 |
-- | Loads an OpCode from the JSON serialised form. |
| 79 | 79 |
loadOpCode :: JSValue -> J.Result OpCode |
| ... | ... | |
| 97 | 97 |
"OP_INSTANCE_FAILOVER" -> do |
| 98 | 98 |
inst <- extract "instance_name" |
| 99 | 99 |
consist <- extract "ignore_consistency" |
| 100 |
return $ OpInstanceFailover inst consist |
|
| 100 |
tnode <- maybeFromObj o "target_node" |
|
| 101 |
return $ OpInstanceFailover inst consist tnode |
|
| 101 | 102 |
"OP_INSTANCE_MIGRATE" -> do |
| 102 | 103 |
inst <- extract "instance_name" |
| 103 | 104 |
live <- extract "live" |
| 104 | 105 |
cleanup <- extract "cleanup" |
| 105 | 106 |
allow_failover <- fromObjWithDefault o "allow_failover" False |
| 106 |
return $ OpInstanceMigrate inst live cleanup allow_failover |
|
| 107 |
tnode <- maybeFromObj o "target_node" |
|
| 108 |
return $ OpInstanceMigrate inst live cleanup |
|
| 109 |
allow_failover tnode |
|
| 107 | 110 |
_ -> J.Error $ "Unknown opcode " ++ op_id |
| 108 | 111 |
|
| 109 | 112 |
-- | Serialises an opcode to JSON. |
| ... | ... | |
| 128 | 131 |
Nothing -> ol2 |
| 129 | 132 |
in makeObj ol3 |
| 130 | 133 |
|
| 131 |
saveOpCode op@(OpInstanceFailover inst consist) = |
|
| 134 |
saveOpCode op@(OpInstanceFailover inst consist tnode) =
|
|
| 132 | 135 |
let ol = [ ("OP_ID", showJSON $ opID op)
|
| 133 | 136 |
, ("instance_name", showJSON inst)
|
| 134 | 137 |
, ("ignore_consistency", showJSON consist) ]
|
| 135 |
in makeObj ol |
|
| 138 |
ol' = case tnode of |
|
| 139 |
Nothing -> ol |
|
| 140 |
Just node -> ("target_node", showJSON node):ol
|
|
| 141 |
in makeObj ol' |
|
| 136 | 142 |
|
| 137 |
saveOpCode op@(OpInstanceMigrate inst live cleanup allow_failover) = |
|
| 143 |
saveOpCode op@(OpInstanceMigrate inst live cleanup allow_failover tnode) =
|
|
| 138 | 144 |
let ol = [ ("OP_ID", showJSON $ opID op)
|
| 139 | 145 |
, ("instance_name", showJSON inst)
|
| 140 | 146 |
, ("live", showJSON live)
|
| 141 | 147 |
, ("cleanup", showJSON cleanup)
|
| 142 | 148 |
, ("allow_failover", showJSON allow_failover) ]
|
| 143 |
in makeObj ol |
|
| 149 |
ol' = case tnode of |
|
| 150 |
Nothing -> ol |
|
| 151 |
Just node -> ("target_node", showJSON node):ol
|
|
| 152 |
in makeObj ol' |
|
| 144 | 153 |
|
| 145 | 154 |
instance JSON OpCode where |
| 146 | 155 |
readJSON = loadOpCode |
Also available in: Unified diff