{-# LINE 1 "src/System/Xen/Mid.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface #-}
{-# LINE 2 "src/System/Xen/Mid.hsc" #-}

-- | Mid-level interface to @XenCtrl@. Functions that provided by this module are
-- version-independent from @Xen@ and raise real exceptions instead of confusing
-- error codes and @errno@.

module System.Xen.Mid
    ( interfaceOpen
    , interfaceClose
    , domainGetInfo
    ) where


{-# LINE 14 "src/System/Xen/Mid.hsc" #-}

import Control.Monad (void, when, forM)
import Foreign.Marshal.Alloc (allocaBytes)
import Foreign.Storable (peekElemOff, sizeOf)

import Control.Monad.Catch (throwM)
import Control.Monad.Trans (MonadIO(liftIO))

import System.Xen.Errors (DomainGetInfoError(..), XcHandleOpenError(..), getErrno)
import System.Xen.Low (xc_interface_open, xc_interface_close, xc_domain_getinfo)
import System.Xen.Types (XcHandle(..), DomId(..), DomainInfo)

-- | Open the connection to the hypervisor interface, can fail with
-- 'System.Xen.Errors.XcHandleOpenError'.
interfaceOpen :: MonadIO m => m XcHandle
interfaceOpen = liftIO $ do

{-# LINE 31 "src/System/Xen/Mid.hsc" #-}
    i@(XcHandle ptr) <- xc_interface_open 0 0 0
    when (ptr `elem` [-1, 0]) $ getErrno >>= throwM . XcHandleOpenError

{-# LINE 37 "src/System/Xen/Mid.hsc" #-}
    return i

-- | Close an open hypervisor interface, ignores all possible errors but all the
-- same can fail with segfault or sutin.
interfaceClose :: (MonadIO m, Functor m) => XcHandle -> m ()
interfaceClose = void . liftIO . xc_interface_close

-- | Returns a list of currently runing domains, 1024 maximum, can fail with
-- 'System.Xen.Errors.InvalidDomainShutdownReason' and
-- 'System.Xen.Errors.DomainGetInfoError'.
domainGetInfo :: MonadIO m => XcHandle -> m [DomainInfo]
domainGetInfo handle = liftIO $ allocaBytes size $ \ptr -> do
     wrote <- fmap fromIntegral $ xc_domain_getinfo handle (dom0) count ptr
     when (wrote == -1) $ getErrno >>= throwM . DomainGetInfoError
     forM [0 .. wrote - 1] $ peekElemOff ptr
  where
    dom0 = DomId 0
    count :: Num a => a
    count = 1024
    size = count * sizeOf (undefined :: DomainInfo)