1 {-# LANGUAGE TemplateHaskell #-}
3 {-| Implementation of the opcodes.
9 Copyright (C) 2009, 2010, 2011, 2012 Google Inc.
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.
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.
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
30 , ReplaceDisksMode(..)
38 import Text.JSON (readJSON, showJSON, makeObj, JSON)
40 import qualified Ganeti.Constants as C
45 -- | Replace disks type.
46 $(declareSADT "ReplaceDisksMode"
47 [ ("ReplaceOnPrimary", 'C.replaceDiskPri)
48 , ("ReplaceOnSecondary", 'C.replaceDiskSec)
49 , ("ReplaceNewSecondary", 'C.replaceDiskChg)
50 , ("ReplaceAuto", 'C.replaceDiskAuto)
52 $(makeJSONInstance ''ReplaceDisksMode)
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)
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 " ++
66 instance JSON DiskIndex where
67 readJSON v = readJSON v >>= mkDiskIndex
68 showJSON = showJSON . unDiskIndex
70 -- | OpCode representation.
72 -- We only implement a subset of Ganeti opcodes, but only what we
73 -- actually use in the htools codebase.
76 [ simpleField "duration" [t| Double |]
77 , simpleField "on_master" [t| Bool |]
78 , simpleField "on_nodes" [t| [String] |]
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 |]
87 , ("OpInstanceFailover",
88 [ simpleField "instance_name" [t| String |]
89 , simpleField "ignore_consistency" [t| Bool |]
90 , optionalField $ simpleField "target_node" [t| String |]
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 |]
101 -- | Returns the OP_ID for a given opcode value.
102 $(genOpID ''OpCode "opID")
104 -- | A list of all defined/supported opcode IDs.
105 $(genAllOpIDs ''OpCode "allOpIDs")
107 instance JSON OpCode where
108 readJSON = loadOpCode
109 showJSON = saveOpCode