| {-# LANGUAGE TemplateHaskell, FunctionalDependencies #-} |
| |
| {-| Implementation of the Ganeti config objects. |
| |
| -} |
| |
| {- |
| |
| Copyright (C) 2011, 2012, 2013, 2014 Google Inc. |
| All rights reserved. |
| |
| Redistribution and use in source and binary forms, with or without |
| modification, are permitted provided that the following conditions are |
| met: |
| |
| 1. Redistributions of source code must retain the above copyright notice, |
| this list of conditions and the following disclaimer. |
| |
| 2. Redistributions in binary form must reproduce the above copyright |
| notice, this list of conditions and the following disclaimer in the |
| documentation and/or other materials provided with the distribution. |
| |
| THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS |
| IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED |
| TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR |
| PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR |
| CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, |
| EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, |
| PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR |
| PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF |
| LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING |
| NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS |
| SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
| |
| -} |
| |
| module Ganeti.Objects |
| ( HvParams |
| , OsParams |
| , OsParamsPrivate |
| , PartialNicParams(..) |
| , FilledNicParams(..) |
| , allNicParamFields |
| , PartialNic(..) |
| , FileDriver(..) |
| , DataCollectorConfig(..) |
| , DiskTemplate(..) |
| , PartialBeParams(..) |
| , FilledBeParams(..) |
| , PartialNDParams(..) |
| , FilledNDParams(..) |
| , allNDParamFields |
| , Node(..) |
| , AllocPolicy(..) |
| , FilledISpecParams(..) |
| , PartialISpecParams(..) |
| , allISpecParamFields |
| , MinMaxISpecs(..) |
| , FilledIPolicy(..) |
| , PartialIPolicy(..) |
| , GroupDiskParams |
| , NodeGroup(..) |
| , FilterAction(..) |
| , FilterPredicate(..) |
| , FilterRule(..) |
| , filterRuleOrder |
| , IpFamily(..) |
| , ipFamilyToRaw |
| , ipFamilyToVersion |
| , fillDict |
| , ClusterHvParams |
| , OsHvParams |
| , ClusterBeParams |
| , ClusterOsParams |
| , ClusterOsParamsPrivate |
| , ClusterNicParams |
| , UidPool |
| , formatUidRange |
| , UidRange |
| , Cluster(..) |
| , ConfigData(..) |
| , TimeStampObject(..) -- re-exported from Types |
| , UuidObject(..) -- re-exported from Types |
| , SerialNoObject(..) -- re-exported from Types |
| , TagsObject(..) -- re-exported from Types |
| , DictObject(..) -- re-exported from THH |
| , TagSet -- re-exported from THH |
| , Network(..) |
| , AddressPool(..) |
| , Ip4Address() |
| , mkIp4Address |
| , Ip4Network() |
| , mkIp4Network |
| , ip4netAddr |
| , ip4netMask |
| , readIp4Address |
| , ip4AddressToList |
| , ip4AddressToNumber |
| , ip4AddressFromNumber |
| , nextIp4Address |
| , IAllocatorParams |
| , MasterNetworkParameters(..) |
| , module Ganeti.PartialParams |
| , module Ganeti.Objects.Disk |
| , module Ganeti.Objects.Instance |
| , module Ganeti.Objects.Maintenance |
| , FilledHvStateParams(..) |
| , PartialHvStateParams(..) |
| , allHvStateParamFields |
| , FilledHvState |
| , PartialHvState ) where |
| |
| import Prelude () |
| import Ganeti.Prelude |
| |
| import Control.Arrow (first) |
| import Control.Monad.State |
| import qualified Data.ByteString.UTF8 as UTF8 |
| import Data.List (foldl', intercalate) |
| import Data.Maybe |
| import qualified Data.Map as Map |
| import Data.Ord (comparing) |
| import Data.Ratio (numerator, denominator) |
| import Data.Tuple (swap) |
| import Data.Word |
| import Text.JSON (showJSON, readJSON, JSON, JSValue(..), fromJSString, |
| toJSString) |
| import qualified Text.JSON as J |
| |
| import qualified AutoConf |
| import qualified Ganeti.Constants as C |
| import qualified Ganeti.ConstantUtils as ConstantUtils |
| import Ganeti.JSON (DictObject(..), Container, emptyContainer, GenericContainer) |
| import Ganeti.Objects.BitArray (BitArray) |
| import Ganeti.Objects.Disk |
| import Ganeti.Objects.Maintenance |
| import Ganeti.Objects.Nic |
| import Ganeti.Objects.Instance |
| import Ganeti.Objects.HvState |
| import Ganeti.Query.Language |
| import Ganeti.PartialParams |
| import Ganeti.Types |
| import Ganeti.THH |
| import Ganeti.THH.Field |
| import Ganeti.Utils (sepSplit, tryRead) |
| |
| -- * Generic definitions |
| |
| -- | Fills one map with keys from the other map, if not already |
| -- existing. Mirrors objects.py:FillDict. |
| fillDict :: (Ord k) => Map.Map k v -> Map.Map k v -> [k] -> Map.Map k v |
| fillDict defaults custom skip_keys = |
| let updated = Map.union custom defaults |
| in foldl' (flip Map.delete) updated skip_keys |
| |
| |
| -- * Network definitions |
| |
| -- ** Ipv4 types |
| |
| data Ip4Address = Ip4Address Word8 Word8 Word8 Word8 |
| deriving (Eq, Ord) |
| |
| mkIp4Address :: (Word8, Word8, Word8, Word8) -> Ip4Address |
| mkIp4Address (a, b, c, d) = Ip4Address a b c d |
| |
| instance Show Ip4Address where |
| show (Ip4Address a b c d) = intercalate "." $ map show [a, b, c, d] |
| |
| readIp4Address :: (Applicative m, Monad m) => String -> m Ip4Address |
| readIp4Address s = |
| case sepSplit '.' s of |
| [a, b, c, d] -> Ip4Address <$> |
| tryRead "first octect" a <*> |
| tryRead "second octet" b <*> |
| tryRead "third octet" c <*> |
| tryRead "fourth octet" d |
| _ -> fail $ "Can't parse IPv4 address from string " ++ s |
| |
| instance JSON Ip4Address where |
| showJSON = showJSON . show |
| readJSON (JSString s) = readIp4Address (fromJSString s) |
| readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 address" |
| |
| -- Converts an address to a list of numbers |
| ip4AddressToList :: Ip4Address -> [Word8] |
| ip4AddressToList (Ip4Address a b c d) = [a, b, c, d] |
| |
| -- | Converts an address into its ordinal number. |
| -- This is needed for indexing IP adresses in reservation pools. |
| ip4AddressToNumber :: Ip4Address -> Integer |
| ip4AddressToNumber = foldl (\n i -> 256 * n + toInteger i) 0 . ip4AddressToList |
| |
| -- | Converts a number into an address. |
| -- This is needed for indexing IP adresses in reservation pools. |
| ip4AddressFromNumber :: Integer -> Ip4Address |
| ip4AddressFromNumber n = |
| let s = state $ first fromInteger . swap . (`divMod` 256) |
| (d, c, b, a) = evalState ((,,,) <$> s <*> s <*> s <*> s) n |
| in Ip4Address a b c d |
| |
| nextIp4Address :: Ip4Address -> Ip4Address |
| nextIp4Address = ip4AddressFromNumber . (+ 1) . ip4AddressToNumber |
| |
| -- | Custom type for an IPv4 network. |
| data Ip4Network = Ip4Network { ip4netAddr :: Ip4Address |
| , ip4netMask :: Word8 |
| } |
| deriving (Eq) |
| |
| mkIp4Network :: Ip4Address -> Word8 -> Ip4Network |
| mkIp4Network = Ip4Network |
| |
| instance Show Ip4Network where |
| show (Ip4Network ip netmask) = show ip ++ "/" ++ show netmask |
| |
| -- | JSON instance for 'Ip4Network'. |
| instance JSON Ip4Network where |
| showJSON = showJSON . show |
| readJSON (JSString s) = |
| case sepSplit '/' (fromJSString s) of |
| [ip, nm] -> do |
| ip' <- readIp4Address ip |
| nm' <- tryRead "parsing netmask" nm |
| if nm' >= 0 && nm' <= 32 |
| then return $ Ip4Network ip' nm' |
| else fail $ "Invalid netmask " ++ show nm' ++ " from string " ++ |
| fromJSString s |
| _ -> fail $ "Can't parse IPv4 network from string " ++ fromJSString s |
| readJSON v = fail $ "Invalid JSON value " ++ show v ++ " for an IPv4 network" |
| |
| -- ** Address pools |
| |
| -- | Currently address pools just wrap a reservation 'BitArray'. |
| -- |
| -- In future, 'Network' might be extended to include several address pools |
| -- and address pools might include their own ranges of addresses. |
| newtype AddressPool = AddressPool { apReservations :: BitArray } |
| deriving (Eq, Ord, Show) |
| |
| instance JSON AddressPool where |
| showJSON = showJSON . apReservations |
| readJSON = liftM AddressPool . readJSON |
| |
| -- ** Ganeti \"network\" config object. |
| |
| -- FIXME: Not all types might be correct here, since they |
| -- haven't been exhaustively deduced from the python code yet. |
| -- |
| -- FIXME: When parsing, check that the ext_reservations and reservations |
| -- have the same length |
| $(buildObject "Network" "network" $ |
| [ simpleField "name" [t| NonEmptyString |] |
| , optionalField $ |
| simpleField "mac_prefix" [t| String |] |
| , simpleField "network" [t| Ip4Network |] |
| , optionalField $ |
| simpleField "network6" [t| String |] |
| , optionalField $ |
| simpleField "gateway" [t| Ip4Address |] |
| , optionalField $ |
| simpleField "gateway6" [t| String |] |
| , optionalField $ |
| simpleField "reservations" [t| AddressPool |] |
| , optionalField $ |
| simpleField "ext_reservations" [t| AddressPool |] |
| ] |
| ++ uuidFields |
| ++ timeStampFields |
| ++ serialFields |
| ++ tagsFields) |
| |
| instance SerialNoObject Network where |
| serialOf = networkSerial |
| |
| instance TagsObject Network where |
| tagsOf = networkTags |
| |
| instance UuidObject Network where |
| uuidOf = UTF8.toString . networkUuid |
| |
| instance TimeStampObject Network where |
| cTimeOf = networkCtime |
| mTimeOf = networkMtime |
| |
| |
| -- * Datacollector definitions |
| type MicroSeconds = Integer |
| |
| -- | The configuration regarding a single data collector. |
| $(buildObject "DataCollectorConfig" "dataCollector" [ |
| simpleField "active" [t| Bool|], |
| simpleField "interval" [t| MicroSeconds |] |
| ]) |
| |
| -- | Central default values of the data collector config. |
| instance Monoid DataCollectorConfig where |
| mempty = DataCollectorConfig |
| { dataCollectorActive = True |
| , dataCollectorInterval = 10^(6::Integer) * fromIntegral C.mondTimeInterval |
| } |
| mappend _ a = a |
| |
| -- * IPolicy definitions |
| |
| $(buildParam "ISpec" "ispec" |
| [ simpleField ConstantUtils.ispecMemSize [t| Int |] |
| , simpleField ConstantUtils.ispecDiskSize [t| Int |] |
| , simpleField ConstantUtils.ispecDiskCount [t| Int |] |
| , simpleField ConstantUtils.ispecCpuCount [t| Int |] |
| , simpleField ConstantUtils.ispecNicCount [t| Int |] |
| , simpleField ConstantUtils.ispecSpindleUse [t| Int |] |
| ]) |
| |
| $(buildObject "MinMaxISpecs" "mmis" |
| [ renameField "MinSpec" $ simpleField "min" [t| FilledISpecParams |] |
| , renameField "MaxSpec" $ simpleField "max" [t| FilledISpecParams |] |
| ]) |
| |
| -- | Custom partial ipolicy. This is not built via buildParam since it |
| -- has a special 2-level inheritance mode. |
| $(buildObject "PartialIPolicy" "ipolicy" |
| [ optionalField . renameField "MinMaxISpecsP" $ |
| simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |] |
| , optionalField . renameField "StdSpecP" $ |
| simpleField "std" [t| PartialISpecParams |] |
| , optionalField . renameField "SpindleRatioP" $ |
| simpleField "spindle-ratio" [t| Double |] |
| , optionalField . renameField "MemoryRatioP" $ |
| simpleField "memory-ratio" [t| Double |] |
| , optionalField . renameField "VcpuRatioP" $ |
| simpleField "vcpu-ratio" [t| Double |] |
| , optionalField . renameField "DiskTemplatesP" $ |
| simpleField "disk-templates" [t| [DiskTemplate] |] |
| ]) |
| |
| -- | Custom filled ipolicy. This is not built via buildParam since it |
| -- has a special 2-level inheritance mode. |
| $(buildObject "FilledIPolicy" "ipolicy" |
| [ renameField "MinMaxISpecs" $ |
| simpleField ConstantUtils.ispecsMinmax [t| [MinMaxISpecs] |] |
| , renameField "StdSpec" $ simpleField "std" [t| FilledISpecParams |] |
| , simpleField "spindle-ratio" [t| Double |] |
| , defaultField [| ConstantUtils.ipolicyDefaultsMemoryRatio |] $ |
| simpleField "memory-ratio" [t| Double |] |
| , simpleField "vcpu-ratio" [t| Double |] |
| , simpleField "disk-templates" [t| [DiskTemplate] |] |
| ]) |
| |
| -- | Custom filler for the ipolicy types. |
| instance PartialParams FilledIPolicy PartialIPolicy where |
| fillParams |
| (FilledIPolicy { ipolicyMinMaxISpecs = fminmax |
| , ipolicyStdSpec = fstd |
| , ipolicySpindleRatio = fspindleRatio |
| , ipolicyMemoryRatio = fmemoryRatio |
| , ipolicyVcpuRatio = fvcpuRatio |
| , ipolicyDiskTemplates = fdiskTemplates}) |
| (PartialIPolicy { ipolicyMinMaxISpecsP = pminmax |
| , ipolicyStdSpecP = pstd |
| , ipolicySpindleRatioP = pspindleRatio |
| , ipolicyMemoryRatioP = pmemoryRatio |
| , ipolicyVcpuRatioP = pvcpuRatio |
| , ipolicyDiskTemplatesP = pdiskTemplates}) = |
| FilledIPolicy |
| { ipolicyMinMaxISpecs = fromMaybe fminmax pminmax |
| , ipolicyStdSpec = maybe fstd (fillParams fstd) pstd |
| , ipolicySpindleRatio = fromMaybe fspindleRatio pspindleRatio |
| , ipolicyMemoryRatio = fromMaybe fmemoryRatio pmemoryRatio |
| , ipolicyVcpuRatio = fromMaybe fvcpuRatio pvcpuRatio |
| , ipolicyDiskTemplates = fromMaybe fdiskTemplates |
| pdiskTemplates |
| } |
| toPartial (FilledIPolicy { ipolicyMinMaxISpecs = fminmax |
| , ipolicyStdSpec = fstd |
| , ipolicySpindleRatio = fspindleRatio |
| , ipolicyMemoryRatio = fmemoryRatio |
| , ipolicyVcpuRatio = fvcpuRatio |
| , ipolicyDiskTemplates = fdiskTemplates}) = |
| PartialIPolicy |
| { ipolicyMinMaxISpecsP = Just fminmax |
| , ipolicyStdSpecP = Just $ toPartial fstd |
| , ipolicySpindleRatioP = Just fspindleRatio |
| , ipolicyMemoryRatioP = Just fmemoryRatio |
| , ipolicyVcpuRatioP = Just fvcpuRatio |
| , ipolicyDiskTemplatesP = Just fdiskTemplates |
| } |
| toFilled (PartialIPolicy { ipolicyMinMaxISpecsP = pminmax |
| , ipolicyStdSpecP = pstd |
| , ipolicySpindleRatioP = pspindleRatio |
| , ipolicyMemoryRatioP = pmemoryRatio |
| , ipolicyVcpuRatioP = pvcpuRatio |
| , ipolicyDiskTemplatesP = pdiskTemplates}) = |
| FilledIPolicy <$> pminmax <*> (toFilled =<< pstd) <*> pspindleRatio |
| <*> pmemoryRatio <*> pvcpuRatio <*> pdiskTemplates |
| |
| -- | Disk state parameters. |
| -- |
| -- As according to the documentation this option is unused by Ganeti, |
| -- the content is just a 'JSValue'. |
| type DiskState = Container JSValue |
| |
| -- * Node definitions |
| |
| $(buildParam "ND" "ndp" |
| [ simpleField "oob_program" [t| String |] |
| , simpleField "spindle_count" [t| Int |] |
| , simpleField "exclusive_storage" [t| Bool |] |
| , simpleField "ovs" [t| Bool |] |
| , simpleField "ovs_name" [t| String |] |
| , simpleField "ovs_link" [t| String |] |
| , simpleField "ssh_port" [t| Int |] |
| , simpleField "cpu_speed" [t| Double |] |
| ]) |
| |
| $(buildObject "Node" "node" $ |
| [ simpleField "name" [t| String |] |
| , simpleField "primary_ip" [t| String |] |
| , simpleField "secondary_ip" [t| String |] |
| , simpleField "master_candidate" [t| Bool |] |
| , simpleField "offline" [t| Bool |] |
| , simpleField "drained" [t| Bool |] |
| , simpleField "group" [t| String |] |
| , simpleField "master_capable" [t| Bool |] |
| , simpleField "vm_capable" [t| Bool |] |
| , simpleField "ndparams" [t| PartialNDParams |] |
| , simpleField "powered" [t| Bool |] |
| , notSerializeDefaultField [| emptyContainer |] $ |
| simpleField "hv_state_static" [t| PartialHvState |] |
| , notSerializeDefaultField [| emptyContainer |] $ |
| simpleField "disk_state_static" [t| DiskState |] |
| ] |
| ++ timeStampFields |
| ++ uuidFields |
| ++ serialFields |
| ++ tagsFields) |
| |
| instance TimeStampObject Node where |
| cTimeOf = nodeCtime |
| mTimeOf = nodeMtime |
| |
| instance UuidObject Node where |
| uuidOf = UTF8.toString . nodeUuid |
| |
| instance SerialNoObject Node where |
| serialOf = nodeSerial |
| |
| instance TagsObject Node where |
| tagsOf = nodeTags |
| |
| -- * NodeGroup definitions |
| |
| -- | The cluster/group disk parameters type. |
| type GroupDiskParams = Container DiskParams |
| |
| -- | A mapping from network UUIDs to nic params of the networks. |
| type Networks = Container PartialNicParams |
| |
| $(buildObject "NodeGroup" "group" $ |
| [ simpleField "name" [t| String |] |
| , defaultField [| [] |] $ simpleField "members" [t| [String] |] |
| , simpleField "ndparams" [t| PartialNDParams |] |
| , simpleField "alloc_policy" [t| AllocPolicy |] |
| , simpleField "ipolicy" [t| PartialIPolicy |] |
| , simpleField "diskparams" [t| GroupDiskParams |] |
| , simpleField "networks" [t| Networks |] |
| , notSerializeDefaultField [| emptyContainer |] $ |
| simpleField "hv_state_static" [t| PartialHvState |] |
| , notSerializeDefaultField [| emptyContainer |] $ |
| simpleField "disk_state_static" [t| DiskState |] |
| ] |
| ++ timeStampFields |
| ++ uuidFields |
| ++ serialFields |
| ++ tagsFields) |
| |
| instance TimeStampObject NodeGroup where |
| cTimeOf = groupCtime |
| mTimeOf = groupMtime |
| |
| instance UuidObject NodeGroup where |
| uuidOf = UTF8.toString . groupUuid |
| |
| instance SerialNoObject NodeGroup where |
| serialOf = groupSerial |
| |
| instance TagsObject NodeGroup where |
| tagsOf = groupTags |
| |
| -- * Job scheduler filtering definitions |
| |
| -- | Actions that can be performed when a filter matches. |
| data FilterAction |
| = Accept |
| | Pause |
| | Reject |
| | Continue |
| | RateLimit Int |
| deriving (Eq, Ord, Show) |
| |
| instance JSON FilterAction where |
| showJSON fa = case fa of |
| Accept -> JSString (toJSString "ACCEPT") |
| Pause -> JSString (toJSString "PAUSE") |
| Reject -> JSString (toJSString "REJECT") |
| Continue -> JSString (toJSString "CONTINUE") |
| RateLimit n -> JSArray [ JSString (toJSString "RATE_LIMIT") |
| , JSRational False (fromIntegral n) |
| ] |
| readJSON v = case v of |
| -- `FilterAction`s are case-sensitive. |
| JSString s | fromJSString s == "ACCEPT" -> return Accept |
| JSString s | fromJSString s == "PAUSE" -> return Pause |
| JSString s | fromJSString s == "REJECT" -> return Reject |
| JSString s | fromJSString s == "CONTINUE" -> return Continue |
| JSArray (JSString s : rest) | fromJSString s == "RATE_LIMIT" -> |
| case rest of |
| [JSRational False n] | denominator n == 1 && numerator n > 0 -> |
| return . RateLimit . fromIntegral $ numerator n |
| _ -> fail "RATE_LIMIT argument must be a positive integer" |
| x -> fail $ "malformed FilterAction JSON: " ++ J.showJSValue x "" |
| |
| |
| data FilterPredicate |
| = FPJobId (Filter FilterField) |
| | FPOpCode (Filter FilterField) |
| | FPReason (Filter FilterField) |
| deriving (Eq, Ord, Show) |
| |
| |
| instance JSON FilterPredicate where |
| showJSON fp = case fp of |
| FPJobId expr -> JSArray [string "jobid", showJSON expr] |
| FPOpCode expr -> JSArray [string "opcode", showJSON expr] |
| FPReason expr -> JSArray [string "reason", showJSON expr] |
| where |
| string = JSString . toJSString |
| |
| readJSON v = case v of |
| -- Predicate names are case-sensitive. |
| JSArray [JSString name, expr] |
| | name == toJSString "jobid" -> FPJobId <$> readJSON expr |
| | name == toJSString "opcode" -> FPOpCode <$> readJSON expr |
| | name == toJSString "reason" -> FPReason <$> readJSON expr |
| JSArray (JSString name:params) -> |
| fail $ "malformed FilterPredicate: bad parameter list for\ |
| \ '" ++ fromJSString name ++ "' predicate: " |
| ++ J.showJSArray params "" |
| _ -> fail "malformed FilterPredicate: must be a list with the first\ |
| \ entry being a string describing the predicate type" |
| |
| |
| $(buildObject "FilterRule" "fr" $ |
| [ simpleField "watermark" [t| JobId |] |
| , simpleField "priority" [t| NonNegative Int |] |
| , simpleField "predicates" [t| [FilterPredicate] |] |
| , simpleField "action" [t| FilterAction |] |
| , simpleField "reason_trail" [t| ReasonTrail |] |
| ] |
| ++ uuidFields) |
| |
| instance UuidObject FilterRule where |
| uuidOf = UTF8.toString . frUuid |
| |
| |
| -- | Order in which filter rules are evaluated, according to |
| -- `doc/design-optables.rst`. |
| -- For `FilterRule` fields not specified as important for the order, |
| -- we choose an arbitrary ordering effect (after the ones from the spec). |
| -- |
| -- The `Ord` instance for `FilterRule` agrees with this function. |
| -- Yet it is recommended to use this function instead of `compare` to be |
| -- explicit that the spec order is used. |
| filterRuleOrder :: FilterRule -> FilterRule -> Ordering |
| filterRuleOrder = compare |
| |
| |
| instance Ord FilterRule where |
| -- It is important that the Ord instance respects the ordering given in |
| -- `doc/design-optables.rst` for the fields defined in there. The other |
| -- fields may be ordered arbitrarily. |
| -- Use `filterRuleOrder` when relying on the spec order. |
| compare = |
| comparing $ \(FilterRule watermark prio predicates action reason uuid) -> |
| ( prio, watermark, uuid -- spec part |
| , predicates, action, reason -- arbitrary part |
| ) |
| |
| |
| -- | IP family type |
| $(declareIADT "IpFamily" |
| [ ("IpFamilyV4", 'AutoConf.pyAfInet4) |
| , ("IpFamilyV6", 'AutoConf.pyAfInet6) |
| ]) |
| $(makeJSONInstance ''IpFamily) |
| |
| -- | Conversion from IP family to IP version. This is needed because |
| -- Python uses both, depending on context. |
| ipFamilyToVersion :: IpFamily -> Int |
| ipFamilyToVersion IpFamilyV4 = C.ip4Version |
| ipFamilyToVersion IpFamilyV6 = C.ip6Version |
| |
| -- | Cluster HvParams (hvtype to hvparams mapping). |
| type ClusterHvParams = GenericContainer Hypervisor HvParams |
| |
| -- | Cluster Os-HvParams (os to hvparams mapping). |
| type OsHvParams = Container ClusterHvParams |
| |
| -- | Cluser BeParams. |
| type ClusterBeParams = Container FilledBeParams |
| |
| -- | Cluster OsParams. |
| type ClusterOsParams = Container OsParams |
| type ClusterOsParamsPrivate = Container (Private OsParams) |
| |
| -- | Cluster NicParams. |
| type ClusterNicParams = Container FilledNicParams |
| |
| -- | A low-high UID ranges. |
| type UidRange = (Int, Int) |
| |
| formatUidRange :: UidRange -> String |
| formatUidRange (lower, higher) |
| | lower == higher = show lower |
| | otherwise = show lower ++ "-" ++ show higher |
| |
| -- | Cluster UID Pool, list (low, high) UID ranges. |
| type UidPool = [UidRange] |
| |
| -- | The iallocator parameters type. |
| type IAllocatorParams = Container JSValue |
| |
| -- | The master candidate client certificate digests |
| type CandidateCertificates = Container String |
| |
| -- * Cluster definitions |
| $(buildObject "Cluster" "cluster" $ |
| [ simpleField "rsahostkeypub" [t| String |] |
| , optionalField $ |
| simpleField "dsahostkeypub" [t| String |] |
| , simpleField "highest_used_port" [t| Int |] |
| , simpleField "tcpudp_port_pool" [t| [Int] |] |
| , simpleField "mac_prefix" [t| String |] |
| , optionalField $ |
| simpleField "volume_group_name" [t| String |] |
| , simpleField "reserved_lvs" [t| [String] |] |
| , optionalField $ |
| simpleField "drbd_usermode_helper" [t| String |] |
| , simpleField "master_node" [t| String |] |
| , simpleField "master_ip" [t| String |] |
| , simpleField "master_netdev" [t| String |] |
| , simpleField "master_netmask" [t| Int |] |
| , simpleField "use_external_mip_script" [t| Bool |] |
| , simpleField "cluster_name" [t| String |] |
| , simpleField "file_storage_dir" [t| String |] |
| , simpleField "shared_file_storage_dir" [t| String |] |
| , simpleField "gluster_storage_dir" [t| String |] |
| , simpleField "enabled_hypervisors" [t| [Hypervisor] |] |
| , simpleField "hvparams" [t| ClusterHvParams |] |
| , simpleField "os_hvp" [t| OsHvParams |] |
| , simpleField "beparams" [t| ClusterBeParams |] |
| , simpleField "osparams" [t| ClusterOsParams |] |
| , simpleField "osparams_private_cluster" [t| ClusterOsParamsPrivate |] |
| , simpleField "nicparams" [t| ClusterNicParams |] |
| , simpleField "ndparams" [t| FilledNDParams |] |
| , simpleField "diskparams" [t| GroupDiskParams |] |
| , simpleField "candidate_pool_size" [t| Int |] |
| , simpleField "modify_etc_hosts" [t| Bool |] |
| , simpleField "modify_ssh_setup" [t| Bool |] |
| , simpleField "maintain_node_health" [t| Bool |] |
| , simpleField "uid_pool" [t| UidPool |] |
| , simpleField "default_iallocator" [t| String |] |
| , simpleField "default_iallocator_params" [t| IAllocatorParams |] |
| , simpleField "hidden_os" [t| [String] |] |
| , simpleField "blacklisted_os" [t| [String] |] |
| , simpleField "primary_ip_family" [t| IpFamily |] |
| , simpleField "prealloc_wipe_disks" [t| Bool |] |
| , simpleField "ipolicy" [t| FilledIPolicy |] |
| , notSerializeDefaultField [| emptyContainer |] $ |
| simpleField "hv_state_static" [t| FilledHvState |] |
| , notSerializeDefaultField [| emptyContainer |] $ |
| simpleField "disk_state_static" [t| DiskState |] |
| , simpleField "enabled_disk_templates" [t| [DiskTemplate] |] |
| , simpleField "candidate_certs" [t| CandidateCertificates |] |
| , simpleField "max_running_jobs" [t| Int |] |
| , simpleField "max_tracked_jobs" [t| Int |] |
| , simpleField "install_image" [t| String |] |
| , simpleField "instance_communication_network" [t| String |] |
| , simpleField "zeroing_image" [t| String |] |
| , simpleField "compression_tools" [t| [String] |] |
| , simpleField "enabled_user_shutdown" [t| Bool |] |
| , simpleField "data_collectors" [t| Container DataCollectorConfig |] |
| , defaultField [| [] |] $ simpleField |
| "diagnose_data_collector_filename" [t| String |] |
| , simpleField "ssh_key_type" [t| SshKeyType |] |
| , simpleField "ssh_key_bits" [t| Int |] |
| ] |
| ++ timeStampFields |
| ++ uuidFields |
| ++ serialFields |
| ++ tagsFields) |
| |
| instance TimeStampObject Cluster where |
| cTimeOf = clusterCtime |
| mTimeOf = clusterMtime |
| |
| instance UuidObject Cluster where |
| uuidOf = UTF8.toString . clusterUuid |
| |
| instance SerialNoObject Cluster where |
| serialOf = clusterSerial |
| |
| instance TagsObject Cluster where |
| tagsOf = clusterTags |
| |
| -- * ConfigData definitions |
| |
| $(buildObject "ConfigData" "config" $ |
| -- timeStampFields ++ |
| [ simpleField "version" [t| Int |] |
| , simpleField "cluster" [t| Cluster |] |
| , simpleField "nodes" [t| Container Node |] |
| , simpleField "nodegroups" [t| Container NodeGroup |] |
| , simpleField "instances" [t| Container Instance |] |
| , simpleField "networks" [t| Container Network |] |
| , simpleField "disks" [t| Container Disk |] |
| , simpleField "filters" [t| Container FilterRule |] |
| , simpleField "maintenance" [t| MaintenanceData |] |
| ] |
| ++ timeStampFields |
| ++ serialFields) |
| |
| instance SerialNoObject ConfigData where |
| serialOf = configSerial |
| |
| instance TimeStampObject ConfigData where |
| cTimeOf = configCtime |
| mTimeOf = configMtime |
| |
| -- * Master network parameters |
| |
| $(buildObject "MasterNetworkParameters" "masterNetworkParameters" |
| [ simpleField "uuid" [t| String |] |
| , simpleField "ip" [t| String |] |
| , simpleField "netmask" [t| Int |] |
| , simpleField "netdev" [t| String |] |
| , simpleField "ip_family" [t| IpFamily |] |
| ]) |
| |
