{-# LINE 1 "src/System/Xen/Types.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "src/System/Xen/Types.hsc" #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}

-- | Types for working with 'XenCtrl' data and accoring 'Storable' instances.
module System.Xen.Types
    ( XcHandle(..)
    , DomId(..)
    , DomainFlag(..)
    , DomainShutdownReason(..)
    , DomainInfo(..)
    ) where


{-# LINE 16 "src/System/Xen/Types.hsc" #-}

{-# LINE 17 "src/System/Xen/Types.hsc" #-}


{-# LINE 19 "src/System/Xen/Types.hsc" #-}

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(..))

{-# LINE 28 "src/System/Xen/Types.hsc" #-}
import Foreign.C (CIntPtr(..))

{-# LINE 30 "src/System/Xen/Types.hsc" #-}
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(..))

-- | Entry point of the hypervisor interface connection, it's a file descriptor
-- in xen 3 and pointer to corresponging structure in xen 4.

{-# LINE 43 "src/System/Xen/Types.hsc" #-}
newtype XcHandle = XcHandle CIntPtr

{-# LINE 47 "src/System/Xen/Types.hsc" #-}
    deriving (Eq, Ord, Show, Storable)

-- | Domain id, wrapper around 'Word32'.
newtype DomId = DomId { unDomId :: Word32 }
    deriving (Eq, Ord, Show, Read, Storable)

-- | Domain flags. It's translated from xc_dominfo structure, so it's possible to
-- be mutual exclusion flags in one domain, e.g. 'DomainFlagShutdown' and
-- 'DomainFlagRunning'.
data DomainFlag = DomainFlagDying
                | DomainFlagCrashed
                | DomainFlagShutdown
                | DomainFlagPaused
                | DomainFlagBlocked
                | DomainFlagRunning
                | DomainFlagHVM
                | DomainFlagDebugged
    deriving (Enum, Eq, Ord, Show, Read)

-- | Domain shutdown reason it's only meaningful if domain has 'DomainFlagShutdown'
-- flag.
data DomainShutdownReason = DomainShutdownReasonPoweroff
                          | DomainShutdownReasonReboot
                          | DomainShutdownReasonSuspend
                          | DomainShutdownReasonCrash
                          | DomainShutdownReasonWatchdog
    deriving (Eq, Ord, Show, Read)

-- | Information about a single domain.
data DomainInfo = DomainInfo
    { domainInfoId                  :: {-# UNPACK #-} !DomId
    , domainInfoSsidRef             :: {-# UNPACK #-} !Word32
    , domainInfoFlags               :: BitSet DomainFlag
    , domainInfoShutdownReason      :: Maybe DomainShutdownReason
    , domainInfoNumberOfPages       :: {-# UNPACK #-} !Word32

{-# LINE 83 "src/System/Xen/Types.hsc" #-}
    , domainInfoNumberOfSharedPages :: {-# UNPACK #-} !Word32

{-# LINE 85 "src/System/Xen/Types.hsc" #-}
    , domainInfoSharedInfoFrame     :: {-# UNPACK #-} !Word32
    , domainInfoCpuTime             :: {-# UNPACK #-} !Word64
    , domainInfoMaxMemKb            :: {-# UNPACK #-} !Word32
    , domainInfoNubmerOfOnlineVcpus :: {-# UNPACK #-} !Word32
    , domainInfoMaxVcpuId           :: {-# UNPACK #-} !Word32
    , domainInfoDomHandle           :: {-# UNPACK #-} !UUID

{-# LINE 92 "src/System/Xen/Types.hsc" #-}
    , domainInfoCpuPool             :: {-# UNPACK #-} !Word32

{-# LINE 94 "src/System/Xen/Types.hsc" #-}
    } deriving (Eq, Ord, Show, Read)

-- | Constats used in this instance defined in <xen/sched.h>.
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
{-# LINE 102 "src/System/Xen/Types.hsc" #-}
        1   -> return DomainShutdownReasonReboot
{-# LINE 103 "src/System/Xen/Types.hsc" #-}
        2  -> return DomainShutdownReasonSuspend
{-# LINE 104 "src/System/Xen/Types.hsc" #-}
        3    -> return DomainShutdownReasonCrash
{-# LINE 105 "src/System/Xen/Types.hsc" #-}
        4 -> return DomainShutdownReasonWatchdog
{-# LINE 106 "src/System/Xen/Types.hsc" #-}
        invalid           -> throwIO $ InvalidDomainShutdownReason invalid
    poke ptr a = poke (castPtr ptr :: Ptr CInt) $ case a of
        DomainShutdownReasonPoweroff -> 0
{-# LINE 109 "src/System/Xen/Types.hsc" #-}
        DomainShutdownReasonReboot   -> 1
{-# LINE 110 "src/System/Xen/Types.hsc" #-}
        DomainShutdownReasonSuspend  -> 2
{-# LINE 111 "src/System/Xen/Types.hsc" #-}
        DomainShutdownReasonCrash    -> 3
{-# LINE 112 "src/System/Xen/Types.hsc" #-}
        DomainShutdownReasonWatchdog -> 4
{-# LINE 113 "src/System/Xen/Types.hsc" #-}

instance Storable DomainInfo where
    sizeOf _ = (68)
{-# LINE 116 "src/System/Xen/Types.hsc" #-}
    alignment _ = 4
{-# LINE 117 "src/System/Xen/Types.hsc" #-}
    peek ptr = do
        domainInfoId                  <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 119 "src/System/Xen/Types.hsc" #-}
        domainInfoSsidRef             <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
{-# LINE 120 "src/System/Xen/Types.hsc" #-}
        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
{-# LINE 137 "src/System/Xen/Types.hsc" #-}
            else return Nothing
        domainInfoNumberOfPages       <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 139 "src/System/Xen/Types.hsc" #-}

{-# LINE 140 "src/System/Xen/Types.hsc" #-}
        domainInfoNumberOfSharedPages <- (\hsc_ptr -> peekByteOff hsc_ptr 20) ptr
{-# LINE 141 "src/System/Xen/Types.hsc" #-}

{-# LINE 142 "src/System/Xen/Types.hsc" #-}
        domainInfoSharedInfoFrame     <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
{-# LINE 143 "src/System/Xen/Types.hsc" #-}
        domainInfoCpuTime             <- (\hsc_ptr -> peekByteOff hsc_ptr 28) ptr
{-# LINE 144 "src/System/Xen/Types.hsc" #-}
        domainInfoMaxMemKb            <- (\hsc_ptr -> peekByteOff hsc_ptr 36) ptr
{-# LINE 145 "src/System/Xen/Types.hsc" #-}
        domainInfoNubmerOfOnlineVcpus <- (\hsc_ptr -> peekByteOff hsc_ptr 40) ptr
{-# LINE 146 "src/System/Xen/Types.hsc" #-}
        domainInfoMaxVcpuId           <- (\hsc_ptr -> peekByteOff hsc_ptr 44) ptr
{-# LINE 147 "src/System/Xen/Types.hsc" #-}
        domainInfoDomHandle           <- (\hsc_ptr -> peekByteOff hsc_ptr 48) ptr
{-# LINE 148 "src/System/Xen/Types.hsc" #-}

{-# LINE 149 "src/System/Xen/Types.hsc" #-}
        domainInfoCpuPool             <- (\hsc_ptr -> peekByteOff hsc_ptr 64) ptr
{-# LINE 150 "src/System/Xen/Types.hsc" #-}

{-# LINE 151 "src/System/Xen/Types.hsc" #-}
        return $ DomainInfo { .. }
    poke = error "Storable DomainInfo poke: not implemented"