root / Ganeti / OpCodes.hs @ 0f15cc76
History | View | Annotate | Download (4.9 kB)
1 | 702a4ee0 | Iustin Pop | {-| Implementation of the opcodes. |
---|---|---|---|
2 | 702a4ee0 | Iustin Pop | |
3 | 702a4ee0 | Iustin Pop | -} |
4 | 702a4ee0 | Iustin Pop | |
5 | 702a4ee0 | Iustin Pop | {- |
6 | 702a4ee0 | Iustin Pop | |
7 | 702a4ee0 | Iustin Pop | Copyright (C) 2009 Google Inc. |
8 | 702a4ee0 | Iustin Pop | |
9 | 702a4ee0 | Iustin Pop | This program is free software; you can redistribute it and/or modify |
10 | 702a4ee0 | Iustin Pop | it under the terms of the GNU General Public License as published by |
11 | 702a4ee0 | Iustin Pop | the Free Software Foundation; either version 2 of the License, or |
12 | 702a4ee0 | Iustin Pop | (at your option) any later version. |
13 | 702a4ee0 | Iustin Pop | |
14 | 702a4ee0 | Iustin Pop | This program is distributed in the hope that it will be useful, but |
15 | 702a4ee0 | Iustin Pop | WITHOUT ANY WARRANTY; without even the implied warranty of |
16 | 702a4ee0 | Iustin Pop | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
17 | 702a4ee0 | Iustin Pop | General Public License for more details. |
18 | 702a4ee0 | Iustin Pop | |
19 | 702a4ee0 | Iustin Pop | You should have received a copy of the GNU General Public License |
20 | 702a4ee0 | Iustin Pop | along with this program; if not, write to the Free Software |
21 | 702a4ee0 | Iustin Pop | Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA |
22 | 702a4ee0 | Iustin Pop | 02110-1301, USA. |
23 | 702a4ee0 | Iustin Pop | |
24 | 702a4ee0 | Iustin Pop | -} |
25 | 702a4ee0 | Iustin Pop | |
26 | 702a4ee0 | Iustin Pop | module Ganeti.OpCodes |
27 | 702a4ee0 | Iustin Pop | ( OpCode(..) |
28 | 702a4ee0 | Iustin Pop | , ReplaceDisksMode(..) |
29 | 702a4ee0 | Iustin Pop | , opID |
30 | 702a4ee0 | Iustin Pop | ) where |
31 | 702a4ee0 | Iustin Pop | |
32 | 702a4ee0 | Iustin Pop | import Data.List |
33 | 702a4ee0 | Iustin Pop | import Control.Monad |
34 | 702a4ee0 | Iustin Pop | import Text.JSON (JSObject, JSValue, readJSON, showJSON, makeObj, JSON) |
35 | 702a4ee0 | Iustin Pop | import qualified Text.JSON as J |
36 | 702a4ee0 | Iustin Pop | import Text.JSON.Types |
37 | 702a4ee0 | Iustin Pop | |
38 | 702a4ee0 | Iustin Pop | import Ganeti.HTools.Utils |
39 | 702a4ee0 | Iustin Pop | |
40 | 702a4ee0 | Iustin Pop | data ReplaceDisksMode = ReplaceOnPrimary |
41 | 702a4ee0 | Iustin Pop | | ReplaceOnSecondary |
42 | 702a4ee0 | Iustin Pop | | ReplaceNewSecondary |
43 | 702a4ee0 | Iustin Pop | | ReplaceAuto |
44 | 702a4ee0 | Iustin Pop | deriving Show |
45 | 702a4ee0 | Iustin Pop | |
46 | 702a4ee0 | Iustin Pop | instance JSON ReplaceDisksMode where |
47 | 702a4ee0 | Iustin Pop | showJSON m = case m of |
48 | 702a4ee0 | Iustin Pop | ReplaceOnPrimary -> showJSON "replace_on_primary" |
49 | 702a4ee0 | Iustin Pop | ReplaceOnSecondary -> showJSON "replace_on_secondary" |
50 | 702a4ee0 | Iustin Pop | ReplaceNewSecondary -> showJSON "replace_new_secondary" |
51 | 702a4ee0 | Iustin Pop | ReplaceAuto -> showJSON "replace_auto" |
52 | 702a4ee0 | Iustin Pop | readJSON s = case readJSON s of |
53 | 702a4ee0 | Iustin Pop | J.Ok "replace_on_primary" -> J.Ok ReplaceOnPrimary |
54 | 702a4ee0 | Iustin Pop | J.Ok "replace_on_secondary" -> J.Ok ReplaceOnSecondary |
55 | 702a4ee0 | Iustin Pop | J.Ok "replace_new_secondary" -> J.Ok ReplaceNewSecondary |
56 | 702a4ee0 | Iustin Pop | J.Ok "replace_auto" -> J.Ok ReplaceAuto |
57 | 702a4ee0 | Iustin Pop | _ -> J.Error "Can't parse a valid ReplaceDisksMode" |
58 | 702a4ee0 | Iustin Pop | |
59 | 702a4ee0 | Iustin Pop | data OpCode = OpTestDelay Double Bool [String] |
60 | 702a4ee0 | Iustin Pop | | OpReplaceDisks String (Maybe String) ReplaceDisksMode |
61 | 702a4ee0 | Iustin Pop | [Int] (Maybe String) |
62 | 702a4ee0 | Iustin Pop | | OpFailoverInstance String Bool |
63 | 702a4ee0 | Iustin Pop | | OpMigrateInstance String Bool Bool |
64 | 702a4ee0 | Iustin Pop | deriving Show |
65 | 702a4ee0 | Iustin Pop | |
66 | 702a4ee0 | Iustin Pop | |
67 | 702a4ee0 | Iustin Pop | opID :: OpCode -> String |
68 | 702a4ee0 | Iustin Pop | opID (OpTestDelay _ _ _) = "OP_TEST_DELAY" |
69 | 702a4ee0 | Iustin Pop | opID (OpReplaceDisks _ _ _ _ _) = "OP_INSTANCE_REPLACE_DISKS" |
70 | 702a4ee0 | Iustin Pop | opID (OpFailoverInstance _ _) = "OP_INSTANCE_FAILOVER" |
71 | 702a4ee0 | Iustin Pop | opID (OpMigrateInstance _ _ _) = "OP_INSTANCE_MIGRATE" |
72 | 702a4ee0 | Iustin Pop | |
73 | 702a4ee0 | Iustin Pop | loadOpCode :: JSValue -> J.Result OpCode |
74 | 702a4ee0 | Iustin Pop | loadOpCode v = do |
75 | 262f3e6c | Iustin Pop | o <- liftM J.fromJSObject (readJSON v) |
76 | 702a4ee0 | Iustin Pop | op_id <- fromObj "OP_ID" o |
77 | 702a4ee0 | Iustin Pop | case op_id of |
78 | 702a4ee0 | Iustin Pop | "OP_TEST_DELAY" -> do |
79 | 702a4ee0 | Iustin Pop | on_nodes <- fromObj "on_nodes" o |
80 | 702a4ee0 | Iustin Pop | on_master <- fromObj "on_master" o |
81 | 702a4ee0 | Iustin Pop | duration <- fromObj "duration" o |
82 | 702a4ee0 | Iustin Pop | return $ OpTestDelay duration on_master on_nodes |
83 | 702a4ee0 | Iustin Pop | "OP_INSTANCE_REPLACE_DISKS" -> do |
84 | 702a4ee0 | Iustin Pop | inst <- fromObj "instance_name" o |
85 | 702a4ee0 | Iustin Pop | node <- fromObj "remote_node" o |
86 | 702a4ee0 | Iustin Pop | mode <- fromObj "mode" o |
87 | 702a4ee0 | Iustin Pop | disks <- fromObj "disks" o |
88 | 702a4ee0 | Iustin Pop | ialloc <- fromObj "iallocator" o |
89 | 702a4ee0 | Iustin Pop | return $ OpReplaceDisks inst node mode disks ialloc |
90 | 702a4ee0 | Iustin Pop | "OP_INSTANCE_FAILOVER" -> do |
91 | 702a4ee0 | Iustin Pop | inst <- fromObj "instance_name" o |
92 | 702a4ee0 | Iustin Pop | consist <- fromObj "ignore_consistency" o |
93 | 702a4ee0 | Iustin Pop | return $ OpFailoverInstance inst consist |
94 | 702a4ee0 | Iustin Pop | "OP_INSTANCE_MIGRATE" -> do |
95 | 702a4ee0 | Iustin Pop | inst <- fromObj "instance_name" o |
96 | 702a4ee0 | Iustin Pop | live <- fromObj "live" o |
97 | 702a4ee0 | Iustin Pop | cleanup <- fromObj "cleanup" o |
98 | 702a4ee0 | Iustin Pop | return $ OpMigrateInstance inst live cleanup |
99 | 702a4ee0 | Iustin Pop | _ -> J.Error $ "Unknown opcode " ++ op_id |
100 | 702a4ee0 | Iustin Pop | |
101 | 702a4ee0 | Iustin Pop | saveOpCode :: OpCode -> JSValue |
102 | 702a4ee0 | Iustin Pop | saveOpCode op@(OpTestDelay duration on_master on_nodes) = |
103 | 702a4ee0 | Iustin Pop | let ol = [ ("OP_ID", showJSON $ opID op) |
104 | 702a4ee0 | Iustin Pop | , ("duration", showJSON duration) |
105 | 702a4ee0 | Iustin Pop | , ("on_master", showJSON on_master) |
106 | 702a4ee0 | Iustin Pop | , ("on_nodes", showJSON on_nodes) ] |
107 | 702a4ee0 | Iustin Pop | in makeObj ol |
108 | 702a4ee0 | Iustin Pop | |
109 | 702a4ee0 | Iustin Pop | saveOpCode op@(OpReplaceDisks inst node mode disks iallocator) = |
110 | 702a4ee0 | Iustin Pop | let ol = [ ("OP_ID", showJSON $ opID op) |
111 | 702a4ee0 | Iustin Pop | , ("instance_name", showJSON inst) |
112 | 702a4ee0 | Iustin Pop | , ("mode", showJSON mode) |
113 | 702a4ee0 | Iustin Pop | , ("disks", showJSON disks)] |
114 | 702a4ee0 | Iustin Pop | ol2 = case node of |
115 | 702a4ee0 | Iustin Pop | Just n -> ("remote_node", showJSON n):ol |
116 | 702a4ee0 | Iustin Pop | Nothing -> ol |
117 | 702a4ee0 | Iustin Pop | ol3 = case iallocator of |
118 | 702a4ee0 | Iustin Pop | Just i -> ("iallocator", showJSON i):ol2 |
119 | 702a4ee0 | Iustin Pop | Nothing -> ol2 |
120 | 702a4ee0 | Iustin Pop | in makeObj ol3 |
121 | 702a4ee0 | Iustin Pop | |
122 | 702a4ee0 | Iustin Pop | saveOpCode op@(OpFailoverInstance inst consist) = |
123 | 702a4ee0 | Iustin Pop | let ol = [ ("OP_ID", showJSON $ opID op) |
124 | 702a4ee0 | Iustin Pop | , ("instance_name", showJSON inst) |
125 | 702a4ee0 | Iustin Pop | , ("ignore_consistency", showJSON consist) ] |
126 | 702a4ee0 | Iustin Pop | in makeObj ol |
127 | 702a4ee0 | Iustin Pop | |
128 | 702a4ee0 | Iustin Pop | saveOpCode op@(OpMigrateInstance inst live cleanup) = |
129 | 702a4ee0 | Iustin Pop | let ol = [ ("OP_ID", showJSON $ opID op) |
130 | 702a4ee0 | Iustin Pop | , ("instance_name", showJSON inst) |
131 | 702a4ee0 | Iustin Pop | , ("live", showJSON live) |
132 | 702a4ee0 | Iustin Pop | , ("cleanup", showJSON cleanup) ] |
133 | 702a4ee0 | Iustin Pop | in makeObj ol |
134 | 702a4ee0 | Iustin Pop | |
135 | 702a4ee0 | Iustin Pop | instance JSON OpCode where |
136 | 702a4ee0 | Iustin Pop | readJSON = loadOpCode |
137 | 702a4ee0 | Iustin Pop | showJSON = saveOpCode |