Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / OpCodes.hs @ 129734d3

History | View | Annotate | Download (5.8 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 e8230242 Iustin Pop
Copyright (C) 2009, 2010, 2011 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 Control.Monad
33 0903280b Iustin Pop
import Text.JSON (readJSON, showJSON, makeObj, JSON)
34 702a4ee0 Iustin Pop
import qualified Text.JSON as J
35 702a4ee0 Iustin Pop
import Text.JSON.Types
36 702a4ee0 Iustin Pop
37 702a4ee0 Iustin Pop
import Ganeti.HTools.Utils
38 702a4ee0 Iustin Pop
39 525bfb36 Iustin Pop
-- | Replace disks type.
40 702a4ee0 Iustin Pop
data ReplaceDisksMode = ReplaceOnPrimary
41 702a4ee0 Iustin Pop
                  | ReplaceOnSecondary
42 702a4ee0 Iustin Pop
                  | ReplaceNewSecondary
43 702a4ee0 Iustin Pop
                  | ReplaceAuto
44 6bc39970 Iustin Pop
                  deriving (Show, Read, Eq)
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 525bfb36 Iustin Pop
-- | OpCode representation.
60 525bfb36 Iustin Pop
--
61 525bfb36 Iustin Pop
-- We only implement a subset of Ganeti opcodes, but only what we
62 525bfb36 Iustin Pop
-- actually use in the htools codebase.
63 702a4ee0 Iustin Pop
data OpCode = OpTestDelay Double Bool [String]
64 10028866 René Nussbaumer
            | OpInstanceReplaceDisks String (Maybe String) ReplaceDisksMode
65 702a4ee0 Iustin Pop
              [Int] (Maybe String)
66 bbe9758d Iustin Pop
            | OpInstanceFailover String Bool (Maybe String)
67 bbe9758d Iustin Pop
            | OpInstanceMigrate String Bool Bool Bool (Maybe String)
68 6bc39970 Iustin Pop
            deriving (Show, Read, Eq)
69 702a4ee0 Iustin Pop
70 702a4ee0 Iustin Pop
71 525bfb36 Iustin Pop
-- | Computes the OP_ID for an OpCode.
72 702a4ee0 Iustin Pop
opID :: OpCode -> String
73 702a4ee0 Iustin Pop
opID (OpTestDelay _ _ _) = "OP_TEST_DELAY"
74 10028866 René Nussbaumer
opID (OpInstanceReplaceDisks _ _ _ _ _) = "OP_INSTANCE_REPLACE_DISKS"
75 bbe9758d Iustin Pop
opID (OpInstanceFailover {}) = "OP_INSTANCE_FAILOVER"
76 bbe9758d Iustin Pop
opID (OpInstanceMigrate  {}) = "OP_INSTANCE_MIGRATE"
77 702a4ee0 Iustin Pop
78 525bfb36 Iustin Pop
-- | Loads an OpCode from the JSON serialised form.
79 702a4ee0 Iustin Pop
loadOpCode :: JSValue -> J.Result OpCode
80 702a4ee0 Iustin Pop
loadOpCode v = do
81 262f3e6c Iustin Pop
  o <- liftM J.fromJSObject (readJSON v)
82 e8230242 Iustin Pop
  let extract x = fromObj o x
83 e8230242 Iustin Pop
  op_id <- extract "OP_ID"
84 702a4ee0 Iustin Pop
  case op_id of
85 702a4ee0 Iustin Pop
    "OP_TEST_DELAY" -> do
86 e8230242 Iustin Pop
                 on_nodes  <- extract "on_nodes"
87 e8230242 Iustin Pop
                 on_master <- extract "on_master"
88 e8230242 Iustin Pop
                 duration  <- extract "duration"
89 702a4ee0 Iustin Pop
                 return $ OpTestDelay duration on_master on_nodes
90 702a4ee0 Iustin Pop
    "OP_INSTANCE_REPLACE_DISKS" -> do
91 e8230242 Iustin Pop
                 inst   <- extract "instance_name"
92 e8230242 Iustin Pop
                 node   <- maybeFromObj o "remote_node"
93 e8230242 Iustin Pop
                 mode   <- extract "mode"
94 e8230242 Iustin Pop
                 disks  <- extract "disks"
95 e8230242 Iustin Pop
                 ialloc <- maybeFromObj o "iallocator"
96 10028866 René Nussbaumer
                 return $ OpInstanceReplaceDisks inst node mode disks ialloc
97 702a4ee0 Iustin Pop
    "OP_INSTANCE_FAILOVER" -> do
98 e8230242 Iustin Pop
                 inst    <- extract "instance_name"
99 e8230242 Iustin Pop
                 consist <- extract "ignore_consistency"
100 bbe9758d Iustin Pop
                 tnode   <- maybeFromObj o "target_node"
101 bbe9758d Iustin Pop
                 return $ OpInstanceFailover inst consist tnode
102 702a4ee0 Iustin Pop
    "OP_INSTANCE_MIGRATE" -> do
103 e8230242 Iustin Pop
                 inst    <- extract "instance_name"
104 e8230242 Iustin Pop
                 live    <- extract "live"
105 e8230242 Iustin Pop
                 cleanup <- extract "cleanup"
106 9470b6ee Iustin Pop
                 allow_failover <- fromObjWithDefault o "allow_failover" False
107 bbe9758d Iustin Pop
                 tnode   <- maybeFromObj o "target_node"
108 bbe9758d Iustin Pop
                 return $ OpInstanceMigrate inst live cleanup
109 bbe9758d Iustin Pop
                        allow_failover tnode
110 702a4ee0 Iustin Pop
    _ -> J.Error $ "Unknown opcode " ++ op_id
111 702a4ee0 Iustin Pop
112 525bfb36 Iustin Pop
-- | Serialises an opcode to JSON.
113 702a4ee0 Iustin Pop
saveOpCode :: OpCode -> JSValue
114 702a4ee0 Iustin Pop
saveOpCode op@(OpTestDelay duration on_master on_nodes) =
115 702a4ee0 Iustin Pop
    let ol = [ ("OP_ID", showJSON $ opID op)
116 702a4ee0 Iustin Pop
             , ("duration", showJSON duration)
117 702a4ee0 Iustin Pop
             , ("on_master", showJSON on_master)
118 702a4ee0 Iustin Pop
             , ("on_nodes", showJSON on_nodes) ]
119 702a4ee0 Iustin Pop
    in makeObj ol
120 702a4ee0 Iustin Pop
121 10028866 René Nussbaumer
saveOpCode op@(OpInstanceReplaceDisks inst node mode disks iallocator) =
122 702a4ee0 Iustin Pop
    let ol = [ ("OP_ID", showJSON $ opID op)
123 702a4ee0 Iustin Pop
             , ("instance_name", showJSON inst)
124 702a4ee0 Iustin Pop
             , ("mode", showJSON mode)
125 702a4ee0 Iustin Pop
             , ("disks", showJSON disks)]
126 702a4ee0 Iustin Pop
        ol2 = case node of
127 702a4ee0 Iustin Pop
                Just n -> ("remote_node", showJSON n):ol
128 702a4ee0 Iustin Pop
                Nothing -> ol
129 702a4ee0 Iustin Pop
        ol3 = case iallocator of
130 702a4ee0 Iustin Pop
                Just i -> ("iallocator", showJSON i):ol2
131 702a4ee0 Iustin Pop
                Nothing -> ol2
132 702a4ee0 Iustin Pop
    in makeObj ol3
133 702a4ee0 Iustin Pop
134 bbe9758d Iustin Pop
saveOpCode op@(OpInstanceFailover inst consist tnode) =
135 702a4ee0 Iustin Pop
    let ol = [ ("OP_ID", showJSON $ opID op)
136 702a4ee0 Iustin Pop
             , ("instance_name", showJSON inst)
137 702a4ee0 Iustin Pop
             , ("ignore_consistency", showJSON consist) ]
138 bbe9758d Iustin Pop
        ol' = case tnode of
139 bbe9758d Iustin Pop
                Nothing -> ol
140 bbe9758d Iustin Pop
                Just node -> ("target_node", showJSON node):ol
141 bbe9758d Iustin Pop
    in makeObj ol'
142 702a4ee0 Iustin Pop
143 bbe9758d Iustin Pop
saveOpCode op@(OpInstanceMigrate inst live cleanup allow_failover tnode) =
144 702a4ee0 Iustin Pop
    let ol = [ ("OP_ID", showJSON $ opID op)
145 702a4ee0 Iustin Pop
             , ("instance_name", showJSON inst)
146 702a4ee0 Iustin Pop
             , ("live", showJSON live)
147 8d66f58a René Nussbaumer
             , ("cleanup", showJSON cleanup)
148 8d66f58a René Nussbaumer
             , ("allow_failover", showJSON allow_failover) ]
149 bbe9758d Iustin Pop
        ol' = case tnode of
150 bbe9758d Iustin Pop
                Nothing -> ol
151 bbe9758d Iustin Pop
                Just node -> ("target_node", showJSON node):ol
152 bbe9758d Iustin Pop
    in makeObj ol'
153 702a4ee0 Iustin Pop
154 702a4ee0 Iustin Pop
instance JSON OpCode where
155 702a4ee0 Iustin Pop
    readJSON = loadOpCode
156 702a4ee0 Iustin Pop
    showJSON = saveOpCode