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 -- | Replace disks type.
40 data ReplaceDisksMode = ReplaceOnPrimary
44 deriving (Show, Read, Eq)
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 -- | OpCode representation.
61 -- We only implement a subset of Ganeti opcodes, but only what we
62 -- actually use in the htools codebase.
63 data OpCode = OpTestDelay Double Bool [String]
64 | OpInstanceReplaceDisks String (Maybe String) ReplaceDisksMode
66 | OpInstanceFailover String Bool
67 | OpInstanceMigrate String Bool Bool Bool
68 deriving (Show, Read, Eq)
71 -- | Computes the OP_ID for an OpCode.
72 opID :: OpCode -> String
73 opID (OpTestDelay _ _ _) = "OP_TEST_DELAY"
74 opID (OpInstanceReplaceDisks _ _ _ _ _) = "OP_INSTANCE_REPLACE_DISKS"
75 opID (OpInstanceFailover _ _) = "OP_INSTANCE_FAILOVER"
76 opID (OpInstanceMigrate _ _ _ _) = "OP_INSTANCE_MIGRATE"
78 -- | Loads an OpCode from the JSON serialised form.
79 loadOpCode :: JSValue -> J.Result OpCode
81 o <- liftM J.fromJSObject (readJSON v)
82 let extract x = fromObj o x
83 op_id <- extract "OP_ID"
86 on_nodes <- extract "on_nodes"
87 on_master <- extract "on_master"
88 duration <- extract "duration"
89 return $ OpTestDelay duration on_master on_nodes
90 "OP_INSTANCE_REPLACE_DISKS" -> do
91 inst <- extract "instance_name"
92 node <- maybeFromObj o "remote_node"
93 mode <- extract "mode"
94 disks <- extract "disks"
95 ialloc <- maybeFromObj o "iallocator"
96 return $ OpInstanceReplaceDisks inst node mode disks ialloc
97 "OP_INSTANCE_FAILOVER" -> do
98 inst <- extract "instance_name"
99 consist <- extract "ignore_consistency"
100 return $ OpInstanceFailover inst consist
101 "OP_INSTANCE_MIGRATE" -> do
102 inst <- extract "instance_name"
103 live <- extract "live"
104 cleanup <- extract "cleanup"
105 allow_failover <- fromObjWithDefault o "allow_failover" False
106 return $ OpInstanceMigrate inst live cleanup allow_failover
107 _ -> J.Error $ "Unknown opcode " ++ op_id
109 -- | Serialises an opcode to JSON.
110 saveOpCode :: OpCode -> JSValue
111 saveOpCode op@(OpTestDelay duration on_master on_nodes) =
112 let ol = [ ("OP_ID", showJSON $ opID op)
113 , ("duration", showJSON duration)
114 , ("on_master", showJSON on_master)
115 , ("on_nodes", showJSON on_nodes) ]
118 saveOpCode op@(OpInstanceReplaceDisks inst node mode disks iallocator) =
119 let ol = [ ("OP_ID", showJSON $ opID op)
120 , ("instance_name", showJSON inst)
121 , ("mode", showJSON mode)
122 , ("disks", showJSON disks)]
124 Just n -> ("remote_node", showJSON n):ol
126 ol3 = case iallocator of
127 Just i -> ("iallocator", showJSON i):ol2
131 saveOpCode op@(OpInstanceFailover inst consist) =
132 let ol = [ ("OP_ID", showJSON $ opID op)
133 , ("instance_name", showJSON inst)
134 , ("ignore_consistency", showJSON consist) ]
137 saveOpCode op@(OpInstanceMigrate inst live cleanup allow_failover) =
138 let ol = [ ("OP_ID", showJSON $ opID op)
139 , ("instance_name", showJSON inst)
140 , ("live", showJSON live)
141 , ("cleanup", showJSON cleanup)
142 , ("allow_failover", showJSON allow_failover) ]
145 instance JSON OpCode where
146 readJSON = loadOpCode
147 showJSON = saveOpCode