Statistics
| Branch: | Tag: | Revision:

root / Ganeti / OpCodes.hs @ 6bc39970

History | View | Annotate | Download (4.9 kB)

1
{-| Implementation of the opcodes.
2

    
3
-}
4

    
5
{-
6

    
7
Copyright (C) 2009, 2010 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
data ReplaceDisksMode = ReplaceOnPrimary
40
                  | ReplaceOnSecondary
41
                  | ReplaceNewSecondary
42
                  | ReplaceAuto
43
                  deriving (Show, Read, Eq)
44

    
45
instance JSON ReplaceDisksMode where
46
    showJSON m = case m of
47
                 ReplaceOnPrimary -> showJSON "replace_on_primary"
48
                 ReplaceOnSecondary -> showJSON "replace_on_secondary"
49
                 ReplaceNewSecondary -> showJSON "replace_new_secondary"
50
                 ReplaceAuto -> showJSON "replace_auto"
51
    readJSON s = case readJSON s of
52
                   J.Ok "replace_on_primary" -> J.Ok ReplaceOnPrimary
53
                   J.Ok "replace_on_secondary" -> J.Ok ReplaceOnSecondary
54
                   J.Ok "replace_new_secondary" -> J.Ok ReplaceNewSecondary
55
                   J.Ok "replace_auto" -> J.Ok ReplaceAuto
56
                   _ -> J.Error "Can't parse a valid ReplaceDisksMode"
57

    
58
data OpCode = OpTestDelay Double Bool [String]
59
            | OpReplaceDisks String (Maybe String) ReplaceDisksMode
60
              [Int] (Maybe String)
61
            | OpFailoverInstance String Bool
62
            | OpMigrateInstance String Bool Bool
63
            deriving (Show, Read, Eq)
64

    
65

    
66
opID :: OpCode -> String
67
opID (OpTestDelay _ _ _) = "OP_TEST_DELAY"
68
opID (OpReplaceDisks _ _ _ _ _) = "OP_INSTANCE_REPLACE_DISKS"
69
opID (OpFailoverInstance _ _) = "OP_INSTANCE_FAILOVER"
70
opID (OpMigrateInstance _ _ _) = "OP_INSTANCE_MIGRATE"
71

    
72
loadOpCode :: JSValue -> J.Result OpCode
73
loadOpCode v = do
74
  o <- liftM J.fromJSObject (readJSON v)
75
  op_id <- fromObj "OP_ID" o
76
  case op_id of
77
    "OP_TEST_DELAY" -> do
78
                 on_nodes <- fromObj "on_nodes" o
79
                 on_master <- fromObj "on_master" o
80
                 duration <- fromObj "duration" o
81
                 return $ OpTestDelay duration on_master on_nodes
82
    "OP_INSTANCE_REPLACE_DISKS" -> do
83
                 inst <- fromObj "instance_name" o
84
                 node <- maybeFromObj "remote_node" o
85
                 mode <- fromObj "mode" o
86
                 disks <- fromObj "disks" o
87
                 ialloc <- maybeFromObj "iallocator" o
88
                 return $ OpReplaceDisks inst node mode disks ialloc
89
    "OP_INSTANCE_FAILOVER" -> do
90
                 inst <- fromObj "instance_name" o
91
                 consist <- fromObj "ignore_consistency" o
92
                 return $ OpFailoverInstance inst consist
93
    "OP_INSTANCE_MIGRATE" -> do
94
                 inst <- fromObj "instance_name" o
95
                 live <- fromObj "live" o
96
                 cleanup <- fromObj "cleanup" o
97
                 return $ OpMigrateInstance inst live cleanup
98
    _ -> J.Error $ "Unknown opcode " ++ op_id
99

    
100
saveOpCode :: OpCode -> JSValue
101
saveOpCode op@(OpTestDelay duration on_master on_nodes) =
102
    let ol = [ ("OP_ID", showJSON $ opID op)
103
             , ("duration", showJSON duration)
104
             , ("on_master", showJSON on_master)
105
             , ("on_nodes", showJSON on_nodes) ]
106
    in makeObj ol
107

    
108
saveOpCode op@(OpReplaceDisks inst node mode disks iallocator) =
109
    let ol = [ ("OP_ID", showJSON $ opID op)
110
             , ("instance_name", showJSON inst)
111
             , ("mode", showJSON mode)
112
             , ("disks", showJSON disks)]
113
        ol2 = case node of
114
                Just n -> ("remote_node", showJSON n):ol
115
                Nothing -> ol
116
        ol3 = case iallocator of
117
                Just i -> ("iallocator", showJSON i):ol2
118
                Nothing -> ol2
119
    in makeObj ol3
120

    
121
saveOpCode op@(OpFailoverInstance inst consist) =
122
    let ol = [ ("OP_ID", showJSON $ opID op)
123
             , ("instance_name", showJSON inst)
124
             , ("ignore_consistency", showJSON consist) ]
125
    in makeObj ol
126

    
127
saveOpCode op@(OpMigrateInstance inst live cleanup) =
128
    let ol = [ ("OP_ID", showJSON $ opID op)
129
             , ("instance_name", showJSON inst)
130
             , ("live", showJSON live)
131
             , ("cleanup", showJSON cleanup) ]
132
    in makeObj ol
133

    
134
instance JSON OpCode where
135
    readJSON = loadOpCode
136
    showJSON = saveOpCode