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

   1 {-# LANGUAGE TemplateHaskell #-}
   2
   3 {-| Implementation of the opcodes.
   4
   5 -}
   6
   7 {-
   8
   9 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
  10
  11 This program is free software; you can redistribute it and/or modify
  12 it under the terms of the GNU General Public License as published by
  13 the Free Software Foundation; either version 2 of the License, or
  14 (at your option) any later version.
  15
  16 This program is distributed in the hope that it will be useful, but
  17 WITHOUT ANY WARRANTY; without even the implied warranty of
  18 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 General Public License for more details.
  20
  21 You should have received a copy of the GNU General Public License
  22 along with this program; if not, write to the Free Software
  23 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
  24 02110-1301, USA.
  25
  26 -}
  27
  28 module Ganeti.OpCodes
  29   ( OpCode(..)
  30   , ReplaceDisksMode(..)
  31   , DiskIndex
  32   , mkDiskIndex
  33   , unDiskIndex
  34   , opID
  35   , allOpIDs
  36   ) where
  37
  38 import Text.JSON (readJSON, showJSON, makeObj, JSON)
  39
  40 import qualified Ganeti.Constants as C
  41 import Ganeti.THH
  42
  43 import Ganeti.JSON
  44
  45 -- | Replace disks type.
  46 $(declareSADT "ReplaceDisksMode"
  47   [ ("ReplaceOnPrimary",    'C.replaceDiskPri)
  48   , ("ReplaceOnSecondary",  'C.replaceDiskSec)
  49   , ("ReplaceNewSecondary", 'C.replaceDiskChg)
  50   , ("ReplaceAuto",         'C.replaceDiskAuto)
  51   ])
  52 $(makeJSONInstance ''ReplaceDisksMode)
  53
  54 -- | Disk index type (embedding constraints on the index value via a
  55 -- smart constructor).
  56 newtype DiskIndex = DiskIndex { unDiskIndex :: Int }
  57   deriving (Show, Read, Eq, Ord)
  58
  59 -- | Smart constructor for 'DiskIndex'.
  60 mkDiskIndex :: (Monad m) => Int -> m DiskIndex
  61 mkDiskIndex i | i >= 0 && i < C.maxDisks = return (DiskIndex i)
  62               | otherwise = fail $ "Invalid value for disk index '" ++
  63                             show i ++ "', required between 0 and " ++
  64                             show C.maxDisks
  65
  66 instance JSON DiskIndex where
  67   readJSON v = readJSON v >>= mkDiskIndex
  68   showJSON = showJSON . unDiskIndex
  69
  70 -- | OpCode representation.
  71 --
  72 -- We only implement a subset of Ganeti opcodes, but only what we
  73 -- actually use in the htools codebase.
  74 $(genOpCode "OpCode"
  75   [ ("OpTestDelay",
  76      [ simpleField "duration"  [t| Double   |]
  77      , simpleField "on_master" [t| Bool     |]
  78      , simpleField "on_nodes"  [t| [String] |]
  79      ])
  80   , ("OpInstanceReplaceDisks",
  81      [ simpleField "instance_name" [t| String |]
  82      , optionalField $ simpleField "remote_node" [t| String |]
  83      , simpleField "mode"  [t| ReplaceDisksMode |]
  84      , simpleField "disks" [t| [DiskIndex] |]
  85      , optionalField $ simpleField "iallocator" [t| String |]
  86      ])
  87   , ("OpInstanceFailover",
  88      [ simpleField "instance_name"      [t| String |]
  89      , simpleField "ignore_consistency" [t| Bool   |]
  90      , optionalField $ simpleField "target_node" [t| String |]
  91      ])
  92   , ("OpInstanceMigrate",
  93      [ simpleField "instance_name"  [t| String |]
  94      , simpleField "live"           [t| Bool   |]
  95      , simpleField "cleanup"        [t| Bool   |]
  96      , defaultField [| False |] $ simpleField "allow_failover" [t| Bool |]
  97      , optionalField $ simpleField "target_node" [t| String |]
  98      ])
  99   ])
 100
 101 -- | Returns the OP_ID for a given opcode value.
 102 $(genOpID ''OpCode "opID")
 103
 104 -- | A list of all defined/supported opcode IDs.
 105 $(genAllOpIDs ''OpCode "allOpIDs")
 106
 107 instance JSON OpCode where
 108   readJSON = loadOpCode
 109   showJSON = saveOpCode