module System.Xen.Types
( XcHandle(..)
, DomId(..)
, DomainFlag(..)
, DomainShutdownReason(..)
, DomainInfo(..)
) where
import Prelude hiding (elem)
import Control.Applicative ((<$>))
import Data.Bits (testBit)
import Data.Maybe (catMaybes)
import Data.Word (Word32, Word64)
import Foreign.C (CInt(..), CUInt(..))
import Foreign.C (CIntPtr(..))
import Foreign.Ptr (Ptr, castPtr)
import Foreign.Storable (Storable(..))
import Control.Exception.Lifted (throwIO)
import Data.UUID (UUID)
import Data.BitSet (BitSet)
import qualified Data.BitSet as BitSet
import System.Xen.Errors (InvalidDomainShutdownReason(..))
newtype XcHandle = XcHandle CIntPtr
deriving (Eq, Ord, Show, Storable)
newtype DomId = DomId { unDomId :: Word32 }
deriving (Eq, Ord, Show, Read, Storable)
data DomainFlag = DomainFlagDying
| DomainFlagCrashed
| DomainFlagShutdown
| DomainFlagPaused
| DomainFlagBlocked
| DomainFlagRunning
| DomainFlagHVM
| DomainFlagDebugged
deriving (Enum, Eq, Ord, Show, Read)
data DomainShutdownReason = DomainShutdownReasonPoweroff
| DomainShutdownReasonReboot
| DomainShutdownReasonSuspend
| DomainShutdownReasonCrash
| DomainShutdownReasonWatchdog
deriving (Eq, Ord, Show, Read)
data DomainInfo = DomainInfo
{ domainInfoId :: !DomId
, domainInfoSsidRef :: !Word32
, domainInfoFlags :: BitSet DomainFlag
, domainInfoShutdownReason :: Maybe DomainShutdownReason
, domainInfoNumberOfPages :: !Word32
, domainInfoNumberOfSharedPages :: !Word32
, domainInfoSharedInfoFrame :: !Word32
, domainInfoCpuTime :: !Word64
, domainInfoMaxMemKb :: !Word32
, domainInfoNubmerOfOnlineVcpus :: !Word32
, domainInfoMaxVcpuId :: !Word32
, domainInfoDomHandle :: !UUID
, domainInfoCpuPool :: !Word32
} deriving (Eq, Ord, Show, Read)
instance Storable DomainShutdownReason where
sizeOf _ = sizeOf (undefined :: CInt)
alignment _ = alignment (undefined :: CInt)
peek ptr = peek (castPtr ptr :: Ptr CInt) >>= \i -> case i of
0 -> return DomainShutdownReasonPoweroff
1 -> return DomainShutdownReasonReboot
2 -> return DomainShutdownReasonSuspend
3 -> return DomainShutdownReasonCrash
4 -> return DomainShutdownReasonWatchdog
invalid -> throwIO $ InvalidDomainShutdownReason invalid
poke ptr a = poke (castPtr ptr :: Ptr CInt) $ case a of
DomainShutdownReasonPoweroff -> 0
DomainShutdownReasonReboot -> 1
DomainShutdownReasonSuspend -> 2
DomainShutdownReasonCrash -> 3
DomainShutdownReasonWatchdog -> 4
instance Storable DomainInfo where
sizeOf _ = (68)
alignment _ = 4
peek ptr = do
domainInfoId <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
domainInfoSsidRef <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
domainInfoFlags <- do
b :: CUInt <- peekByteOff ptr $
sizeOf domainInfoId + sizeOf domainInfoSsidRef
let maybeBit n v = if testBit b n then Just v else Nothing
return $ BitSet.fromList $ catMaybes
[ maybeBit 0 DomainFlagDying
, maybeBit 1 DomainFlagCrashed
, maybeBit 2 DomainFlagShutdown
, maybeBit 3 DomainFlagPaused
, maybeBit 4 DomainFlagBlocked
, maybeBit 5 DomainFlagRunning
, maybeBit 6 DomainFlagHVM
, maybeBit 7 DomainFlagDebugged
]
domainInfoShutdownReason <-
if DomainFlagShutdown `BitSet.member` domainInfoFlags
then Just <$> (\hsc_ptr -> peekByteOff hsc_ptr 12) ptr
else return Nothing
domainInfoNumberOfPages <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
domainInfoNumberOfSharedPages <- (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr
domainInfoSharedInfoFrame <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
domainInfoCpuTime <- (\hsc_ptr -> peekByteOff hsc_ptr 28) ptr
domainInfoMaxMemKb <- (\hsc_ptr -> peekByteOff hsc_ptr 36) ptr
domainInfoNubmerOfOnlineVcpus <- (\hsc_ptr -> peekByteOff hsc_ptr 40) ptr
domainInfoMaxVcpuId <- (\hsc_ptr -> peekByteOff hsc_ptr 44) ptr
domainInfoDomHandle <- (\hsc_ptr -> peekByteOff hsc_ptr 48) ptr
domainInfoCpuPool <- (\hsc_ptr -> peekByteOff hsc_ptr 64) ptr
return $ DomainInfo { .. }
poke = error "Storable DomainInfo poke: not implemented"