{-# LINE 1 "System/Xen/CBindings.hsc" #-}
module System.Xen.CBindings
{-# LINE 2 "System/Xen/CBindings.hsc" #-}
    ( xc_interface_open
    , xc_interface_close
    , xc_find_device_number
    , xc_domain_create
    , xc_domain_dumpcore
    , xc_domain_dumpcore_via_callback
    , xc_domain_max_vcpus
    , xc_domain_pause
    , xc_domain_unpause
    , xc_domain_destroy
    , xc_domain_resume
    , xc_domain_shutdown
    , xc_vcpu_setaffinity
    , xc_vcpu_getaffinity
    , xc_domain_getinfo
    , xc_domain_getinfolist
    , xc_CORE_MAGIC
    , xc_CORE_MAGIC_HVM
    , DomId(..)
    , XCHandle(..)
    ) where

import Data.Bits
import Data.List (foldl1')
import Data.Word
import Data.Array.IArray
import Foreign.C
import Foreign.Ptr
import Foreign.Storable
import Foreign.Marshal.Array


{-# LINE 34 "System/Xen/CBindings.hsc" #-}

xc_CORE_MAGIC :: CInt
xc_CORE_MAGIC = 0xF00FEBED

xc_CORE_MAGIC_HVM :: CInt
xc_CORE_MAGIC_HVM = 0xF00FEBEE

data DomainFlag = Dying | Crashed | Shutdown | Paused | Blocked | Running | HVM | Debugged deriving (Eq, Ord, Show, Enum)

instance Storable [DomainFlag] where
    sizeOf _ = sizeOf (undefined :: CUInt)
    alignment _ = alignment (undefined :: CUInt)
    peek ptr = do
        v <- peek (castPtr ptr)
        return $ fromBits v
    poke ptr a = poke (castPtr ptr) (toBits a)

toBits :: [DomainFlag] -> CUInt
toBits flgs = foldl1' (.|.) (map (bit . fromEnum) flgs)

fromBits :: CUInt -> [DomainFlag]
fromBits v = map (toEnum . fst) flagsSet
  where
  flagsSet :: [(Int,Bool)]
  flagsSet = filter ((==True) . snd) (zip [0..] flgVals)
  flgVals :: [Bool]
  flgVals = map (uncurry testBit) (zip (repeat v) [0..31])

data XC_DomInfo = XC_DomInfo {
    diDomId           :: Word32,
    diSSIDRef         :: Word32,
    diFlags           :: [DomainFlag],
    diShutdownReason  :: XCShutdown,
    diNrPages         :: CUInt,
    diSharedInfoFrame :: CUInt,
    diCpuTime         :: Word64,
    diMaxMemKB        :: CULong,
    diNrOnlineVCPUs   :: CUInt,
    diMaxVCPUId       :: CUInt,
    diDomHandle       :: [XenDomainHandle]
  } deriving (Eq, Ord, Show)

type XenDomainHandle = Word8
type XenDomainHandleT = Ptr Word8

instance Storable XC_DomInfo where
    sizeOf _= ((60))
{-# LINE 81 "System/Xen/CBindings.hsc" #-}
    alignment _ = alignment (undefined :: Word64)
    peek ptr = do
         domId    <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 84 "System/Xen/CBindings.hsc" #-}
         ssidRef  <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 85 "System/Xen/CBindings.hsc" #-}
         flags <- peekByteOff ptr (sizeOf domId + sizeOf ssidRef)
         sr    <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 87 "System/Xen/CBindings.hsc" #-}
         nrPgs <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 88 "System/Xen/CBindings.hsc" #-}
         infoF <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 89 "System/Xen/CBindings.hsc" #-}
         cpuT  <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 90 "System/Xen/CBindings.hsc" #-}
         maxM  <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 91 "System/Xen/CBindings.hsc" #-}
         nrOC  <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) ptr
{-# LINE 92 "System/Xen/CBindings.hsc" #-}
         maxCI <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
{-# LINE 93 "System/Xen/CBindings.hsc" #-}
         dh    <- peekArray 16 (plusPtr ptr ((44)))
{-# LINE 94 "System/Xen/CBindings.hsc" #-}
         return $ XC_DomInfo domId ssidRef flags sr nrPgs infoF cpuT maxM nrOC maxCI dh
    poke ptr a = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (diDomId a)
{-# LINE 97 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr (diSSIDRef a)
{-# LINE 98 "System/Xen/CBindings.hsc" #-}
        pokeByteOff ptr (sizeOf (diDomId a) + sizeOf (diSSIDRef a)) (diFlags a)
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr (diShutdownReason a)
{-# LINE 100 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (diNrPages a)
{-# LINE 101 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr (diSharedInfoFrame a)
{-# LINE 102 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr (diCpuTime a)
{-# LINE 103 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr (diMaxMemKB a)
{-# LINE 104 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) ptr (diNrOnlineVCPUs a)
{-# LINE 105 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr (diMaxVCPUId a)
{-# LINE 106 "System/Xen/CBindings.hsc" #-}
        let p = plusPtr ptr 76
            domHandles = take 16 $ diDomHandle a ++ repeat 0
        pokeArray p domHandles

-- FIXME VCPU Guest Context Type

-- SHUTDOWN constants can be found in <xen/sched.h>
data XCShutdown = SHUTDOWN_poweroff | SHUTDOWN_reboot | SHUTDOWN_suspend | SHUTDOWN_crash
    deriving (Eq, Ord, Show, Read, Enum)

instance Storable XCShutdown where
    sizeOf _ = sizeOf (undefined :: CInt)
    alignment _ = alignment (undefined :: CInt)
    peek ptr = peek (castPtr ptr :: Ptr CInt) >>= return . toEnum . fromIntegral
    poke ptr a = poke (castPtr ptr :: Ptr CInt) (fromIntegral (fromEnum a))

newtype XCHandle = XCHdl CInt deriving (Eq, Ord, Show)

instance Storable XCHandle where
    sizeOf _ = sizeOf (undefined :: CInt)
    alignment _ = alignment (undefined :: CInt)
    peek ptr = peek (castPtr ptr) >>= return . XCHdl
    poke ptr (XCHdl h) = poke (castPtr ptr) h

newtype DomId = DomId Word32 deriving (Eq, Ord, Show)

instance Storable DomId where
    sizeOf _ = sizeOf (undefined :: Word32)
    alignment _ = alignment (undefined :: Word32)
    peek ptr = peek (castPtr ptr) >>= return . DomId
    poke ptr i = poke (castPtr ptr) i

foreign import ccall unsafe "xc_interface_open"
    xc_interface_open :: IO XCHandle

foreign import ccall unsafe "xc_interface_close"
    xc_interface_close :: XCHandle -> IO CInt

foreign import ccall unsafe "xc_find_device_number"
    xc_find_device_number :: CString -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_domain_create"
    xc_domain_create :: XCHandle -> DomId -> XenDomainHandleT -> Word32 -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_domain_dumpcore"
    xc_domain_dumpcore :: XCHandle -> DomId -> CString -> IO CInt

type Dumpcore_rtn_t = FunPtr (Ptr Word8 -> CString -> CUInt -> IO CInt)

foreign import ccall safe "xenctrl.h xc_domain_dumpcore_via_callback"
    xc_domain_dumpcore_via_callback :: XCHandle -> DomId -> Ptr Word8 -> IO Dumpcore_rtn_t

foreign import ccall unsafe "xenctrl.h xc_domain_max_vcpus"
    xc_domain_max_vcpus :: XCHandle -> DomId -> CUInt -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_domain_pause"
    xc_domain_pause :: XCHandle -> DomId -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_domain_unpause"
    xc_domain_unpause :: XCHandle -> DomId -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_domain_destroy"
    xc_domain_destroy :: XCHandle -> DomId -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_domain_resume"
    xc_domain_resume :: XCHandle -> DomId -> CInt -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_domain_shutdown"
     xc_domain_shutdown :: XCHandle -> DomId -> CInt -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_vcpu_setaffinity"
    xc_vcpu_setaffinity :: XCHandle -> DomId -> CInt -> Word64 -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_vcpu_getaffinity"
    xc_vcpu_getaffinity :: XCHandle -> DomId -> CInt -> Ptr Word64 -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_domain_getinfo"
    xc_domain_getinfo :: XCHandle -> DomId -> CUInt -> Ptr XC_DomInfo -> IO CInt

-- TODO need to base VCPU_Guest_Context on arch specific info
-- how can I trick that info from cabal and use it here?
--
-- foreign import ccall unsafe "xenctrl.h xc_vcpu_setcontext"
--     xc_vcpu_setcontext :: XCHandle -> DomId -> Word32 -> Ptr VCPU_Guest_Context -> IO CInt

foreign import ccall unsafe "xenctrl.h xc_domain_getinfolist"
    xc_domain_getinfolist :: XCHandle -> DomId -> CUInt -> Ptr XC_DomInfo -> CInt

-- Data and functions for debugging
data XC_Core_Header = XC_Core_Header {
      xchMagic       :: CInt
    , xchNrVCPUs     :: CInt
    , xchNrPages     :: CInt
    , xchCTXTOffset  :: CInt
    , xchIndexOffset :: CInt
    , xchPagesOffset :: CInt } deriving (Eq, Ord, Show)

instance Storable XC_Core_Header where
    sizeOf _ = ((24))
{-# LINE 205 "System/Xen/CBindings.hsc" #-}
    alignment _ = alignment (undefined :: CInt)
    peek ptr = do
        m <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 208 "System/Xen/CBindings.hsc" #-}
        v <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 209 "System/Xen/CBindings.hsc" #-}
        p <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 210 "System/Xen/CBindings.hsc" #-}
        c <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 211 "System/Xen/CBindings.hsc" #-}
        i <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 212 "System/Xen/CBindings.hsc" #-}
        g <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 213 "System/Xen/CBindings.hsc" #-}
        return (XC_Core_Header m v p c i g)
    poke ptr (XC_Core_Header m v p c i g) = do
        ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr m
{-# LINE 216 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr v
{-# LINE 217 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr p
{-# LINE 218 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr c
{-# LINE 219 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr i
{-# LINE 220 "System/Xen/CBindings.hsc" #-}
        ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr g
{-# LINE 221 "System/Xen/CBindings.hsc" #-}