| 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
|