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

   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 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   let extract x = fromObj o x
  76   op_id <- extract "OP_ID"
  77   case op_id of
  78     "OP_TEST_DELAY" -> do
  79                  on_nodes  <- extract "on_nodes"
  80                  on_master <- extract "on_master"
  81                  duration  <- extract "duration"
  82                  return $ OpTestDelay duration on_master on_nodes
  83     "OP_INSTANCE_REPLACE_DISKS" -> do
  84                  inst   <- extract "instance_name"
  85                  node   <- maybeFromObj o "remote_node"
  86                  mode   <- extract "mode"
  87                  disks  <- extract "disks"
  88                  ialloc <- maybeFromObj o "iallocator"
  89                  return $ OpReplaceDisks inst node mode disks ialloc
  90     "OP_INSTANCE_FAILOVER" -> do
  91                  inst    <- extract "instance_name"
  92                  consist <- extract "ignore_consistency"
  93                  return $ OpFailoverInstance inst consist
  94     "OP_INSTANCE_MIGRATE" -> do
  95                  inst    <- extract "instance_name"
  96                  live    <- extract "live"
  97                  cleanup <- extract "cleanup"
  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