diff --git a/htools/Ganeti/Objects.hs b/htools/Ganeti/Objects.hs index d20edb413d8595a6e4f4081fe1425cce95366269..d382b5218da009b1ce9867c471c40057805abfa5 100644 --- a/htools/Ganeti/Objects.hs +++ b/htools/Ganeti/Objects.hs @@ -72,11 +72,16 @@ module Ganeti.Objects , ClusterNicParams , Cluster(..) , ConfigData(..) + , TimeStampObject(..) + , UuidObject(..) + , SerialNoObject(..) + , TagsObject(..) ) where import Data.List (foldl') import Data.Maybe import qualified Data.Map as Map +import qualified Data.Set as Set import Text.JSON (makeObj, showJSON, readJSON, JSON, JSValue(..)) import qualified Text.JSON as J @@ -103,6 +108,23 @@ type HvParams = Container JSValue -- the values are always strings. type OsParams = Container String +-- | Class of objects that have timestamps. +class TimeStampObject a where + cTimeOf :: a -> Double + mTimeOf :: a -> Double + +-- | Class of objects that have an UUID. +class UuidObject a where + uuidOf :: a -> String + +-- | Class of object that have a serial number. +class SerialNoObject a where + serialOf :: a -> Int + +-- | Class of objects that have tags. +class TagsObject a where + tagsOf :: a -> Set.Set String + -- * NIC definitions $(declareSADT "NICMode" @@ -325,6 +347,19 @@ $(buildObject "Instance" "inst" $ ++ serialFields ++ tagsFields) +instance TimeStampObject Instance where + cTimeOf = instCtime + mTimeOf = instMtime + +instance UuidObject Instance where + uuidOf = instUuid + +instance SerialNoObject Instance where + serialOf = instSerial + +instance TagsObject Instance where + tagsOf = instTags + -- * IPolicy definitions $(buildParam "ISpec" "ispec" $ @@ -407,6 +442,19 @@ $(buildObject "Node" "node" $ ++ serialFields ++ tagsFields) +instance TimeStampObject Node where + cTimeOf = nodeCtime + mTimeOf = nodeMtime + +instance UuidObject Node where + uuidOf = nodeUuid + +instance SerialNoObject Node where + serialOf = nodeSerial + +instance TagsObject Node where + tagsOf = nodeTags + -- * NodeGroup definitions -- | The Group allocation policy type. @@ -440,6 +488,19 @@ $(buildObject "NodeGroup" "group" $ ++ serialFields ++ tagsFields) +instance TimeStampObject NodeGroup where + cTimeOf = groupCtime + mTimeOf = groupMtime + +instance UuidObject NodeGroup where + uuidOf = groupUuid + +instance SerialNoObject NodeGroup where + serialOf = groupSerial + +instance TagsObject NodeGroup where + tagsOf = groupTags + -- | IP family type $(declareIADT "IpFamily" [ ("IpFamilyV4", 'C.ip4Family) @@ -509,11 +570,24 @@ $(buildObject "Cluster" "cluster" $ , simpleField "prealloc_wipe_disks" [t| Bool |] , simpleField "ipolicy" [t| FilledIPolicy |] ] - ++ serialFields ++ timeStampFields ++ uuidFields + ++ serialFields ++ tagsFields) +instance TimeStampObject Cluster where + cTimeOf = clusterCtime + mTimeOf = clusterMtime + +instance UuidObject Cluster where + uuidOf = clusterUuid + +instance SerialNoObject Cluster where + serialOf = clusterSerial + +instance TagsObject Cluster where + tagsOf = clusterTags + -- * ConfigData definitions $(buildObject "ConfigData" "config" $ @@ -525,3 +599,6 @@ $(buildObject "ConfigData" "config" $ , simpleField "instances" [t| Container Instance |] ] ++ serialFields) + +instance SerialNoObject ConfigData where + serialOf = configSerial