1 {-| Implementation of the opcodes.
7 Copyright (C) 2009, 2010, 2011 Google Inc.
9 This program is free software; you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation; either version 2 of the License, or
12 (at your option) any later version.
14 This program is distributed in the hope that it will be useful, but
15 WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program; if not, write to the Free Software
21 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
28 , ReplaceDisksMode(..)
33 import Text.JSON (readJSON, showJSON, makeObj, JSON)
34 import qualified Text.JSON as J
35 import Text.JSON.Types
37 import Ganeti.HTools.Utils
39 data ReplaceDisksMode = ReplaceOnPrimary
43 deriving (Show, Read, Eq)
45 instance JSON ReplaceDisksMode where
46 showJSON m = case m of
47 ReplaceOnPrimary -> showJSON "replace_on_primary"
48 ReplaceOnSecondary -> showJSON "replace_on_secondary"
49 ReplaceNewSecondary -> showJSON "replace_new_secondary"
50 ReplaceAuto -> showJSON "replace_auto"
51 readJSON s = case readJSON s of
52 J.Ok "replace_on_primary" -> J.Ok ReplaceOnPrimary
53 J.Ok "replace_on_secondary" -> J.Ok ReplaceOnSecondary
54 J.Ok "replace_new_secondary" -> J.Ok ReplaceNewSecondary
55 J.Ok "replace_auto" -> J.Ok ReplaceAuto
56 _ -> J.Error "Can't parse a valid ReplaceDisksMode"
58 data OpCode = OpTestDelay Double Bool [String]
59 | OpReplaceDisks String (Maybe String) ReplaceDisksMode
61 | OpFailoverInstance String Bool
62 | OpMigrateInstance String Bool Bool
63 deriving (Show, Read, Eq)
66 opID :: OpCode -> String
67 opID (OpTestDelay _ _ _) = "OP_TEST_DELAY"
68 opID (OpReplaceDisks _ _ _ _ _) = "OP_INSTANCE_REPLACE_DISKS"
69 opID (OpFailoverInstance _ _) = "OP_INSTANCE_FAILOVER"
70 opID (OpMigrateInstance _ _ _) = "OP_INSTANCE_MIGRATE"
72 loadOpCode :: JSValue -> J.Result OpCode
74 o <- liftM J.fromJSObject (readJSON v)
75 let extract x = fromObj o x
76 op_id <- extract "OP_ID"
79 on_nodes <- extract "on_nodes"
80 on_master <- extract "on_master"
81 duration <- extract "duration"
82 return $ OpTestDelay duration on_master on_nodes
83 "OP_INSTANCE_REPLACE_DISKS" -> do
84 inst <- extract "instance_name"
85 node <- maybeFromObj o "remote_node"
86 mode <- extract "mode"
87 disks <- extract "disks"
88 ialloc <- maybeFromObj o "iallocator"
89 return $ OpReplaceDisks inst node mode disks ialloc
90 "OP_INSTANCE_FAILOVER" -> do
91 inst <- extract "instance_name"
92 consist <- extract "ignore_consistency"
93 return $ OpFailoverInstance inst consist
94 "OP_INSTANCE_MIGRATE" -> do
95 inst <- extract "instance_name"
96 live <- extract "live"
97 cleanup <- extract "cleanup"
98 return $ OpMigrateInstance inst live cleanup
99 _ -> J.Error $ "Unknown opcode " ++ op_id
101 saveOpCode :: OpCode -> JSValue
102 saveOpCode op@(OpTestDelay duration on_master on_nodes) =
103 let ol = [ ("OP_ID", showJSON $ opID op)
104 , ("duration", showJSON duration)
105 , ("on_master", showJSON on_master)
106 , ("on_nodes", showJSON on_nodes) ]
109 saveOpCode op@(OpReplaceDisks inst node mode disks iallocator) =
110 let ol = [ ("OP_ID", showJSON $ opID op)
111 , ("instance_name", showJSON inst)
112 , ("mode", showJSON mode)
113 , ("disks", showJSON disks)]
115 Just n -> ("remote_node", showJSON n):ol
117 ol3 = case iallocator of
118 Just i -> ("iallocator", showJSON i):ol2
122 saveOpCode op@(OpFailoverInstance inst consist) =
123 let ol = [ ("OP_ID", showJSON $ opID op)
124 , ("instance_name", showJSON inst)
125 , ("ignore_consistency", showJSON consist) ]
128 saveOpCode op@(OpMigrateInstance inst live cleanup) =
129 let ol = [ ("OP_ID", showJSON $ opID op)
130 , ("instance_name", showJSON inst)
131 , ("live", showJSON live)
132 , ("cleanup", showJSON cleanup) ]
135 instance JSON OpCode where
136 readJSON = loadOpCode
137 showJSON = saveOpCode