code.grnet.gr Git - ganeti-local/blob - Ganeti/OpCodes.hs

   1 {-| Implementation of the opcodes.
   2
   3 -}
   4
   5 {-
   6
   7 Copyright (C) 2009 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 Data.List
  33 import Control.Monad
  34 import Text.JSON (JSObject, JSValue, readJSON, showJSON, makeObj, JSON)
  35 import qualified Text.JSON as J
  36 import Text.JSON.Types
  37
  38 import Ganeti.HTools.Utils
  39
  40 data ReplaceDisksMode = ReplaceOnPrimary
  41                   | ReplaceOnSecondary
  42                   | ReplaceNewSecondary
  43                   | ReplaceAuto
  44                   deriving Show
  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 data OpCode = OpTestDelay Double Bool [String]
  60             | OpReplaceDisks String (Maybe String) ReplaceDisksMode
  61               [Int] (Maybe String)
  62             | OpFailoverInstance String Bool
  63             | OpMigrateInstance String Bool Bool
  64             deriving Show
  65
  66
  67 opID :: OpCode -> String
  68 opID (OpTestDelay _ _ _) = "OP_TEST_DELAY"
  69 opID (OpReplaceDisks _ _ _ _ _) = "OP_INSTANCE_REPLACE_DISKS"
  70 opID (OpFailoverInstance _ _) = "OP_INSTANCE_FAILOVER"
  71 opID (OpMigrateInstance _ _ _) = "OP_INSTANCE_MIGRATE"
  72
  73 loadOpCode :: JSValue -> J.Result OpCode
  74 loadOpCode v = do
  75   o <- liftM J.fromJSObject (readJSON v)
  76   op_id <- fromObj "OP_ID" o
  77   case op_id of
  78     "OP_TEST_DELAY" -> do
  79                  on_nodes <- fromObj "on_nodes" o
  80                  on_master <- fromObj "on_master" o
  81                  duration <- fromObj "duration" o
  82                  return $ OpTestDelay duration on_master on_nodes
  83     "OP_INSTANCE_REPLACE_DISKS" -> do
  84                  inst <- fromObj "instance_name" o
  85                  node <- fromObj "remote_node" o
  86                  mode <- fromObj "mode" o
  87                  disks <- fromObj "disks" o
  88                  ialloc <- fromObj "iallocator" o
  89                  return $ OpReplaceDisks inst node mode disks ialloc
  90     "OP_INSTANCE_FAILOVER" -> do
  91                  inst <- fromObj "instance_name" o
  92                  consist <- fromObj "ignore_consistency" o
  93                  return $ OpFailoverInstance inst consist
  94     "OP_INSTANCE_MIGRATE" -> do
  95                  inst <- fromObj "instance_name" o
  96                  live <- fromObj "live" o
  97                  cleanup <- fromObj "cleanup" o
  98                  return $ OpMigrateInstance inst live cleanup
  99     _ -> J.Error $ "Unknown opcode " ++ op_id
 100
 101 saveOpCode :: OpCode -> JSValue
 102 saveOpCode op@(OpTestDelay duration on_master on_nodes) =
 103     let ol = [ ("OP_ID", showJSON $ opID op)
 104              , ("duration", showJSON duration)
 105              , ("on_master", showJSON on_master)
 106              , ("on_nodes", showJSON on_nodes) ]
 107     in makeObj ol
 108
 109 saveOpCode op@(OpReplaceDisks inst node mode disks iallocator) =
 110     let ol = [ ("OP_ID", showJSON $ opID op)
 111              , ("instance_name", showJSON inst)
 112              , ("mode", showJSON mode)
 113              , ("disks", showJSON disks)]
 114         ol2 = case node of
 115                 Just n -> ("remote_node", showJSON n):ol
 116                 Nothing -> ol
 117         ol3 = case iallocator of
 118                 Just i -> ("iallocator", showJSON i):ol2
 119                 Nothing -> ol2
 120     in makeObj ol3
 121
 122 saveOpCode op@(OpFailoverInstance inst consist) =
 123     let ol = [ ("OP_ID", showJSON $ opID op)
 124              , ("instance_name", showJSON inst)
 125              , ("ignore_consistency", showJSON consist) ]
 126     in makeObj ol
 127
 128 saveOpCode op@(OpMigrateInstance inst live cleanup) =
 129     let ol = [ ("OP_ID", showJSON $ opID op)
 130              , ("instance_name", showJSON inst)
 131              , ("live", showJSON live)
 132              , ("cleanup", showJSON cleanup) ]
 133     in makeObj ol
 134
 135 instance JSON OpCode where
 136     readJSON = loadOpCode
 137     showJSON = saveOpCode