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 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
  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
  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 <- fromObj "remote_node" o
  85                  mode <- fromObj "mode" o
  86                  disks <- fromObj "disks" o
  87                  ialloc <- fromObj "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