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(..)
34 import Text.JSON (JSObject, JSValue, readJSON, showJSON, makeObj, JSON)
35 import qualified Text.JSON as J
36 import Text.JSON.Types
38 import Ganeti.HTools.Utils
40 data ReplaceDisksMode = ReplaceOnPrimary
46 instance JSON ReplaceDisksMode where
47 showJSON m = case m of
48 ReplaceOnPrimary -> showJSON "replace_on_primary"
49 ReplaceOnSecondary -> showJSON "replace_on_secondary"
50 ReplaceNewSecondary -> showJSON "replace_new_secondary"
51 ReplaceAuto -> showJSON "replace_auto"
52 readJSON s = case readJSON s of
53 J.Ok "replace_on_primary" -> J.Ok ReplaceOnPrimary
54 J.Ok "replace_on_secondary" -> J.Ok ReplaceOnSecondary
55 J.Ok "replace_new_secondary" -> J.Ok ReplaceNewSecondary
56 J.Ok "replace_auto" -> J.Ok ReplaceAuto
57 _ -> J.Error "Can't parse a valid ReplaceDisksMode"
59 data OpCode = OpTestDelay Double Bool [String]
60 | OpReplaceDisks String (Maybe String) ReplaceDisksMode
62 | OpFailoverInstance String Bool
63 | OpMigrateInstance String Bool Bool
67 opID :: OpCode -> String
68 opID (OpTestDelay _ _ _) = "OP_TEST_DELAY"
69 opID (OpReplaceDisks _ _ _ _ _) = "OP_INSTANCE_REPLACE_DISKS"
70 opID (OpFailoverInstance _ _) = "OP_INSTANCE_FAILOVER"
71 opID (OpMigrateInstance _ _ _) = "OP_INSTANCE_MIGRATE"
73 loadOpCode :: JSValue -> J.Result OpCode
75 o <- readJSON v::J.Result (JSObject JSValue)
76 op_id <- fromObj "OP_ID" o
79 on_nodes <- fromObj "on_nodes" o
80 on_master <- fromObj "on_master" o
81 duration <- fromObj "duration" o
82 return $ OpTestDelay duration on_master on_nodes
83 "OP_INSTANCE_REPLACE_DISKS" -> do
84 inst <- fromObj "instance_name" o
85 node <- fromObj "remote_node" o
86 mode <- fromObj "mode" o
87 disks <- fromObj "disks" o
88 ialloc <- fromObj "iallocator" o
89 return $ OpReplaceDisks inst node mode disks ialloc
90 "OP_INSTANCE_FAILOVER" -> do
91 inst <- fromObj "instance_name" o
92 consist <- fromObj "ignore_consistency" o
93 return $ OpFailoverInstance inst consist
94 "OP_INSTANCE_MIGRATE" -> do
95 inst <- fromObj "instance_name" o
96 live <- fromObj "live" o
97 cleanup <- fromObj "cleanup" o
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