1 {-| Implementation of the opcodes.
7 Copyright (C) 2009 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
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
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 op_id <- fromObj "OP_ID" o
78 on_nodes <- fromObj "on_nodes" o
79 on_master <- fromObj "on_master" o
80 duration <- fromObj "duration" o
81 return $ OpTestDelay duration on_master on_nodes
82 "OP_INSTANCE_REPLACE_DISKS" -> do
83 inst <- fromObj "instance_name" o
84 node <- maybeFromObj "remote_node" o
85 mode <- fromObj "mode" o
86 disks <- fromObj "disks" o
87 ialloc <- maybeFromObj "iallocator" o
88 return $ OpReplaceDisks inst node mode disks ialloc
89 "OP_INSTANCE_FAILOVER" -> do
90 inst <- fromObj "instance_name" o
91 consist <- fromObj "ignore_consistency" o
92 return $ OpFailoverInstance inst consist
93 "OP_INSTANCE_MIGRATE" -> do
94 inst <- fromObj "instance_name" o
95 live <- fromObj "live" o
96 cleanup <- fromObj "cleanup" o
97 return $ OpMigrateInstance inst live cleanup
98 _ -> J.Error $ "Unknown opcode " ++ op_id
100 saveOpCode :: OpCode -> JSValue
101 saveOpCode op@(OpTestDelay duration on_master on_nodes) =
102 let ol = [ ("OP_ID", showJSON $ opID op)
103 , ("duration", showJSON duration)
104 , ("on_master", showJSON on_master)
105 , ("on_nodes", showJSON on_nodes) ]
108 saveOpCode op@(OpReplaceDisks inst node mode disks iallocator) =
109 let ol = [ ("OP_ID", showJSON $ opID op)
110 , ("instance_name", showJSON inst)
111 , ("mode", showJSON mode)
112 , ("disks", showJSON disks)]
114 Just n -> ("remote_node", showJSON n):ol
116 ol3 = case iallocator of
117 Just i -> ("iallocator", showJSON i):ol2
121 saveOpCode op@(OpFailoverInstance inst consist) =
122 let ol = [ ("OP_ID", showJSON $ opID op)
123 , ("instance_name", showJSON inst)
124 , ("ignore_consistency", showJSON consist) ]
127 saveOpCode op@(OpMigrateInstance inst live cleanup) =
128 let ol = [ ("OP_ID", showJSON $ opID op)
129 , ("instance_name", showJSON inst)
130 , ("live", showJSON live)
131 , ("cleanup", showJSON cleanup) ]
134 instance JSON OpCode where
135 readJSON = loadOpCode
136 showJSON = saveOpCode