Statistics
| Branch: | Tag: | Revision:

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

History | View | Annotate | Download (5.4 kB)

1
{-| Implementation of the opcodes.
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009, 2010, 2011 Google Inc.
8

    
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.
13

    
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.
18

    
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
22
02110-1301, USA.
23

    
24
-}
25

    
26
module Ganeti.OpCodes
27
    ( OpCode(..)
28
    , ReplaceDisksMode(..)
29
    , opID
30
    ) where
31

    
32
import Control.Monad
33
import Text.JSON (readJSON, showJSON, makeObj, JSON)
34
import qualified Text.JSON as J
35
import Text.JSON.Types
36

    
37
import Ganeti.HTools.Utils
38

    
39
-- | Replace disks type.
40
data ReplaceDisksMode = ReplaceOnPrimary
41
                  | ReplaceOnSecondary
42
                  | ReplaceNewSecondary
43
                  | ReplaceAuto
44
                  deriving (Show, Read, Eq)
45

    
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"
58

    
59
-- | OpCode representation.
60
--
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
65
              [Int] (Maybe String)
66
            | OpInstanceFailover String Bool
67
            | OpInstanceMigrate String Bool Bool Bool
68
            deriving (Show, Read, Eq)
69

    
70

    
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"
77

    
78
-- | Loads an OpCode from the JSON serialised form.
79
loadOpCode :: JSValue -> J.Result OpCode
80
loadOpCode v = do
81
  o <- liftM J.fromJSObject (readJSON v)
82
  let extract x = fromObj o x
83
  op_id <- extract "OP_ID"
84
  case op_id of
85
    "OP_TEST_DELAY" -> do
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
108

    
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) ]
116
    in makeObj ol
117

    
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)]
123
        ol2 = case node of
124
                Just n -> ("remote_node", showJSON n):ol
125
                Nothing -> ol
126
        ol3 = case iallocator of
127
                Just i -> ("iallocator", showJSON i):ol2
128
                Nothing -> ol2
129
    in makeObj ol3
130

    
131
saveOpCode op@(OpInstanceFailover inst consist) =
132
    let ol = [ ("OP_ID", showJSON $ opID op)
133
             , ("instance_name", showJSON inst)
134
             , ("ignore_consistency", showJSON consist) ]
135
    in makeObj ol
136

    
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) ]
143
    in makeObj ol
144

    
145
instance JSON OpCode where
146
    readJSON = loadOpCode
147
    showJSON = saveOpCode