code.grnet.gr Git - ganeti-local/blob - src/Ganeti/Hypervisor/Xen/Types.hs

   1 {-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
   2 {-| Data types for Xen-specific hypervisor functionalities.
   3
   4 -}
   5 {-
   6
   7 Copyright (C) 2013 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 module Ganeti.Hypervisor.Xen.Types
  26   ( LispConfig(..)
  27   , Domain(..)
  28   , FromLispConfig(..)
  29   , UptimeInfo(..)
  30   , ActualState(..)
  31   ) where
  32
  33 import qualified Text.JSON as J
  34
  35 import Ganeti.BasicTypes
  36
  37 -- | Data type representing configuration data as produced by the
  38 -- @xm list --long@ command.
  39 data LispConfig = LCList [LispConfig]
  40                 | LCString String
  41                 | LCDouble Double
  42                 deriving (Eq, Show)
  43
  44 -- | Data type representing a Xen Domain.
  45 data Domain = Domain
  46   { domId      :: Int
  47   , domName    :: String
  48   , domCpuTime :: Double
  49   , domState   :: ActualState
  50   , domIsHung  :: Maybe Bool
  51   } deriving (Show, Eq)
  52
  53 -- | Class representing all the types that can be extracted from LispConfig.
  54 class FromLispConfig a where
  55   fromLispConfig :: LispConfig -> Result a
  56
  57 -- | Instance of FromLispConfig for Int.
  58 instance FromLispConfig Int where
  59   fromLispConfig (LCDouble d) = Ok $ floor d
  60   fromLispConfig (LCList (LCString _:LCDouble d:[])) = Ok $ floor d
  61   fromLispConfig c =
  62     Bad $ "Unable to extract a Int from this configuration: "
  63       ++ show c
  64
  65 -- | Instance of FromLispConfig for Double.
  66 instance FromLispConfig Double where
  67   fromLispConfig (LCDouble d) = Ok d
  68   fromLispConfig (LCList (LCString _:LCDouble d:[])) = Ok d
  69   fromLispConfig c =
  70     Bad $ "Unable to extract a Double from this configuration: "
  71       ++ show c
  72
  73 -- | Instance of FromLispConfig for String
  74 instance FromLispConfig String where
  75   fromLispConfig (LCString s) = Ok s
  76   fromLispConfig (LCList (LCString _:LCString s:[])) = Ok s
  77   fromLispConfig c =
  78     Bad $ "Unable to extract a String from this configuration: "
  79       ++ show c
  80
  81 -- | Instance of FromLispConfig for [LispConfig]
  82 instance FromLispConfig [LispConfig] where
  83   fromLispConfig (LCList l) = Ok l
  84   fromLispConfig c =
  85     Bad $ "Unable to extract a List from this configuration: "
  86       ++ show c
  87
  88 -- Data type representing the information that can be obtained from @xm uptime@
  89 data UptimeInfo = UptimeInfo
  90   { uInfoName   :: String
  91   , uInfoID     :: Int
  92   , uInfoUptime :: String
  93   } deriving (Eq, Show)
  94
  95 data ActualState = ActualRunning  -- ^ The instance is running
  96                  | ActualBlocked  -- ^ The instance is not running or runnable
  97                  | ActualPaused   -- ^ The instance has been paused
  98                  | ActualShutdown -- ^ The instance is shut down
  99                  | ActualCrashed  -- ^ The instance has crashed
 100                  | ActualDying    -- ^ The instance is in process of dying
 101                  | ActualHung     -- ^ The instance is hung
 102                  | ActualUnknown  -- ^ Unknown state. Parsing error.
 103                  deriving (Show, Eq)
 104
 105 instance J.JSON ActualState where
 106   showJSON ActualRunning = J.showJSON "running"
 107   showJSON ActualBlocked = J.showJSON "blocked"
 108   showJSON ActualPaused = J.showJSON "paused"
 109   showJSON ActualShutdown = J.showJSON "shutdown"
 110   showJSON ActualCrashed = J.showJSON "crashed"
 111   showJSON ActualDying = J.showJSON "dying"
 112   showJSON ActualHung = J.showJSON "hung"
 113   showJSON ActualUnknown = J.showJSON "unknown"
 114
 115   readJSON = error "JSON read instance not implemented for type ActualState"