Statistics
| Branch: | Tag: | Revision:

root / htools / Ganeti / OpCodes.hs @ 9bb5721c

History | View | Annotate | Download (5.4 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 10028866 René Nussbaumer
            | OpInstanceFailover String Bool
67 10028866 René Nussbaumer
            | OpInstanceMigrate String Bool Bool Bool
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 10028866 René Nussbaumer
opID (OpInstanceFailover _ _) = "OP_INSTANCE_FAILOVER"
76 10028866 René Nussbaumer
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 10028866 René Nussbaumer
                 return $ OpInstanceFailover inst consist
101 702a4ee0 Iustin Pop
    "OP_INSTANCE_MIGRATE" -> do
102 e8230242 Iustin Pop
                 inst    <- extract "instance_name"
103 e8230242 Iustin Pop
                 live    <- extract "live"
104 e8230242 Iustin Pop
                 cleanup <- extract "cleanup"
105 9470b6ee Iustin Pop
                 allow_failover <- fromObjWithDefault o "allow_failover" False
106 10028866 René Nussbaumer
                 return $ OpInstanceMigrate inst live cleanup allow_failover
107 702a4ee0 Iustin Pop
    _ -> J.Error $ "Unknown opcode " ++ op_id
108 702a4ee0 Iustin Pop
109 525bfb36 Iustin Pop
-- | Serialises an opcode to JSON.
110 702a4ee0 Iustin Pop
saveOpCode :: OpCode -> JSValue
111 702a4ee0 Iustin Pop
saveOpCode op@(OpTestDelay duration on_master on_nodes) =
112 702a4ee0 Iustin Pop
    let ol = [ ("OP_ID", showJSON $ opID op)
113 702a4ee0 Iustin Pop
             , ("duration", showJSON duration)
114 702a4ee0 Iustin Pop
             , ("on_master", showJSON on_master)
115 702a4ee0 Iustin Pop
             , ("on_nodes", showJSON on_nodes) ]
116 702a4ee0 Iustin Pop
    in makeObj ol
117 702a4ee0 Iustin Pop
118 10028866 René Nussbaumer
saveOpCode op@(OpInstanceReplaceDisks inst node mode disks iallocator) =
119 702a4ee0 Iustin Pop
    let ol = [ ("OP_ID", showJSON $ opID op)
120 702a4ee0 Iustin Pop
             , ("instance_name", showJSON inst)
121 702a4ee0 Iustin Pop
             , ("mode", showJSON mode)
122 702a4ee0 Iustin Pop
             , ("disks", showJSON disks)]
123 702a4ee0 Iustin Pop
        ol2 = case node of
124 702a4ee0 Iustin Pop
                Just n -> ("remote_node", showJSON n):ol
125 702a4ee0 Iustin Pop
                Nothing -> ol
126 702a4ee0 Iustin Pop
        ol3 = case iallocator of
127 702a4ee0 Iustin Pop
                Just i -> ("iallocator", showJSON i):ol2
128 702a4ee0 Iustin Pop
                Nothing -> ol2
129 702a4ee0 Iustin Pop
    in makeObj ol3
130 702a4ee0 Iustin Pop
131 10028866 René Nussbaumer
saveOpCode op@(OpInstanceFailover inst consist) =
132 702a4ee0 Iustin Pop
    let ol = [ ("OP_ID", showJSON $ opID op)
133 702a4ee0 Iustin Pop
             , ("instance_name", showJSON inst)
134 702a4ee0 Iustin Pop
             , ("ignore_consistency", showJSON consist) ]
135 702a4ee0 Iustin Pop
    in makeObj ol
136 702a4ee0 Iustin Pop
137 10028866 René Nussbaumer
saveOpCode op@(OpInstanceMigrate inst live cleanup allow_failover) =
138 702a4ee0 Iustin Pop
    let ol = [ ("OP_ID", showJSON $ opID op)
139 702a4ee0 Iustin Pop
             , ("instance_name", showJSON inst)
140 702a4ee0 Iustin Pop
             , ("live", showJSON live)
141 8d66f58a René Nussbaumer
             , ("cleanup", showJSON cleanup)
142 8d66f58a René Nussbaumer
             , ("allow_failover", showJSON allow_failover) ]
143 702a4ee0 Iustin Pop
    in makeObj ol
144 702a4ee0 Iustin Pop
145 702a4ee0 Iustin Pop
instance JSON OpCode where
146 702a4ee0 Iustin Pop
    readJSON = loadOpCode
147 702a4ee0 Iustin Pop
    showJSON = saveOpCode