hen 0.1.0.1 → 0.1.1

raw patch · 8 files changed

+163/−43 lines, 8 filesdep +tastydep +tasty-quickcheckdep −test-frameworkdep −test-framework-quickcheck2dep ~QuickCheckdep ~exceptionsPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: tasty, tasty-quickcheck

Dependencies removed: test-framework, test-framework-quickcheck2

Dependency ranges changed: QuickCheck, exceptions

API changes (from Hackage documentation)

Files

• hen.cabal +7/−7
• src/System/Xen.hs +11/−2
• src/System/Xen/High.hs +31/−3
• src/System/Xen/High/Internal.hs +12/−9
• src/System/Xen/Low.hsc +44/−5
• src/System/Xen/Mid.hsc +53/−11
• src/System/Xen/Types.hsc +3/−4
• tests/Tests.hs +2/−2

@@ -1,5 +1,5 @@ Name:               hen-Version:            0.1.0.1+Version:            0.1.1 Synopsis:           Haskell bindings to Xen hypervisor interface Description:        Haskell bindings to Xen hypervisor interface License:            MIT@@ -24,7 +24,7 @@     Build-depends:      base                      == 4.6.* || == 4.5.*                       , transformers              == 0.3.*                       , mtl                       == 2.1.* || == 2.0.*-                      , exceptions                == 0.1.*+                      , exceptions                == 0.3.*                       , uuid                      == 1.2.*                       , bitset                    == 1.4.* @@ -35,7 +35,7 @@                         System.Xen.Errors                         System.Xen.Mid                         System.Xen.Low-    Extra-libraries:    xenctrl+--    Extra-libraries:    xenctrl  Test-suite hen-tests     Main-is:          Tests.hs@@ -46,14 +46,14 @@     Build-depends:      base                      == 4.6.* || == 4.5.*                       , transformers              == 0.3.*                       , mtl                       == 2.1.* || == 2.0.*-                      , exceptions                == 0.1.*+                      , exceptions                == 0.3.*                       , uuid                      == 1.2.*                       , bitset                    == 1.4.*                       , hen -                      , test-framework             == 0.8.*-                      , test-framework-quickcheck2 == 0.3.*-                      , QuickCheck                 == 2.5.*+                      , tasty                      == 0.3.*+                      , tasty-quickcheck           == 0.3.*+                      , QuickCheck                 == 2.6.*  Source-repository head     Type:     git

@@ -31,14 +31,23 @@     , DomainShutdownReason(..)     , DomainInfo(..)     -- * High-level API+    -- ** Monad stuff     , XenT     , Xen-    , domainGetInfo     , runXenT+    -- ** Domain+    , domainGetInfo+    -- *** Domain pause+    , domainPause+    , domainUnpause+    -- *** Domain powerstate+    , domainShutdown+    , domainDestroy     ) where  import System.Xen.Errors (XcHandleOpenError(..), InvalidDomainShutdownReason(..),                           DomainGetInfoError(..))-import System.Xen.High (XenT, Xen, domainGetInfo, runXenT)+import System.Xen.High (XenT, Xen, domainGetInfo, domainPause, domainUnpause, domainShutdown,+                        domainDestroy, runXenT) import System.Xen.Types (DomId(..), DomainFlag(..), DomainShutdownReason(..),                          DomainInfo(..))

@@ -1,14 +1,23 @@ -- | High-level interface to @XenCtrl@. Contains `Xen` monad and provides a safe way -- to run any `Xen` computation. module System.Xen.High-    ( XenT+    (+    -- * Monad stuff+      XenT     , Xen-    , domainGetInfo     , runXenT+    -- * Domain+    , domainGetInfo+    -- ** Domain pause+    , domainPause+    , domainUnpause+    -- ** Domain powerstate+    , domainShutdown+    , domainDestroy     ) where  import System.Xen.High.Internal (XenT, Xen, MonadXen(withXenHandle), runXenT)-import System.Xen.Types (DomainInfo)+import System.Xen.Types (DomainInfo, DomId, DomainShutdownReason) import qualified System.Xen.Mid as Mid  -- | Returns a lift of domains, this function can fail with@@ -16,3 +25,22 @@ -- 'System.Xen.Errors.DomainGetInfoError'. domainGetInfo :: MonadXen m => m [DomainInfo] domainGetInfo = withXenHandle Mid.domainGetInfo++-- | Pause domain. A paused domain still exists in memory+-- however it does not receive any timeslices from the hypervisor.+domainPause :: MonadXen m => DomId -> m Bool+domainPause = withXenHandle . Mid.domainPause++-- | Unpause a domain. The domain should have been previously paused.+domainUnpause :: MonadXen m => DomId -> m Bool+domainUnpause = withXenHandle . Mid.domainUnpause++-- | Shutdown domain. This is intended for use in fully-virtualized domains where+-- this operation is analogous to the sched_op operations in a paravirtualized domain.+domainShutdown :: MonadXen m => DomId -> DomainShutdownReason -> m Bool+domainShutdown domid reason = withXenHandle $ Mid.domainShutdown domid reason++-- | Destroy a domain.  Destroying a domain removes the domain completely from memory.+-- This function should be called after 'domainShutdown' to free up the domain resources.+domainDestroy :: MonadXen m => DomId -> m Bool+domainDestroy = withXenHandle . Mid.domainDestroy

@@ -22,16 +22,16 @@ import Control.Monad.State (MonadState(..)) import Control.Monad.Writer (MonadWriter(..)) -import Control.Monad.Trans.Identity (IdentityT(..)) import Control.Monad.Trans (MonadIO, MonadTrans(lift))-import qualified Control.Monad.Trans.Cont as Cont-import qualified Control.Monad.Trans.Error as Error-import qualified Control.Monad.Trans.State.Lazy as LazyState-import qualified Control.Monad.Trans.State.Strict as StrictState-import qualified Control.Monad.Trans.Writer.Lazy as LazyWriter-import qualified Control.Monad.Trans.Writer.Strict as StrictWriter-import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS-import qualified Control.Monad.Trans.RWS.Strict as StrictRWS+import Control.Monad.Trans.Identity (IdentityT(..))+import qualified Control.Monad.Cont as Cont+import qualified Control.Monad.Error as Error+import qualified Control.Monad.State.Lazy as LazyState+import qualified Control.Monad.State.Strict as StrictState+import qualified Control.Monad.Writer.Lazy as LazyWriter+import qualified Control.Monad.Writer.Strict as StrictWriter+import qualified Control.Monad.RWS.Lazy as LazyRWS+import qualified Control.Monad.RWS.Strict as StrictRWS  import System.Xen.Types (XcHandle) import qualified System.Xen.Mid as Mid@@ -76,9 +76,12 @@ -- * The @transformers@-style monad transfomer ------------------------------------------------------------------------------ +-- | A Xen transformer. This transformers keeps connection to the Xen+-- hypervisor interface. newtype XenT m a = XenT { unXenT :: ReaderT XcHandle m a }     deriving (Functor, Applicative, Monad, MonadTrans, MonadIO, MonadCatch) +-- | Most simple 'XenT' implementation. type Xen = XenT IO  instance (Functor m, MonadIO m, MonadCatch m) => MonadXen (XenT m) where

@@ -4,9 +4,18 @@ -- a ffi call to corresponding c function.  module System.Xen.Low-    ( xc_interface_open+    (+    -- * Interface+      xc_interface_open     , xc_interface_close+    -- * Domain     , xc_domain_getinfo+    -- ** Domain pause+    , xc_domain_pause+    , xc_domain_unpause+    -- ** Domain powerstate+    , xc_domain_shutdown+    , xc_domain_destroy     ) where  #include <xenctrl.h>@@ -45,10 +54,40 @@ -- one exists. It is, therefore, important in this case to make sure the -- domain requested was the one returned. foreign import ccall unsafe "xenctrl.h xc_domain_getinfo"-    xc_domain_getinfo :: XcHandle  -- ^ Handle to the open hypervisor interface-                      -> DomId -- ^ First domain to enumerate from.-                      -> CUInt -- ^ The number of requested domains+    xc_domain_getinfo :: XcHandle        -- ^ Handle to the open hypervisor interface+                      -> DomId           -- ^ First domain to enumerate from.+                      -> CUInt           -- ^ The number of requested domains                       -> Ptr DomainInfo  -- ^ Pointer to the structure that will                                          -- contain the information for                                          -- enumerated domains-                      -> IO CInt  -- ^ Number of domains enumerated, -1 on error+                      -> IO CInt         -- ^ Number of domains enumerated, -1 on error++-- | This function pauses a domain. A paused domain still exists in memory+-- however it does not receive any timeslices from the hypervisor.+foreign import ccall unsafe "xenctrl.h xc_domain_pause"+    xc_domain_pause :: XcHandle -- ^ Handle to the open hypervisor interface+                    -> DomId    -- ^ Domain to pause+                    -> IO CInt  -- ^ 0 if success, -1 if error++-- | This function unpauses a domain. The domain should have been previously paused.+foreign import ccall unsafe "xenctrl.h xc_domain_unpause"+    xc_domain_unpause :: XcHandle -- ^ Handle to the open hypervisor interface+                      -> DomId    -- ^ Domain to unpause+                      -> IO CInt  -- ^ 0 if success, -1 if error++-- | This function will shutdown a domain. This is intended for use in+-- fully-virtualized domains where this operation is analogous to the+-- sched_op operations in a paravirtualized domain.+foreign import ccall unsafe "xenctrl.h xc_domain_shutdown"+    xc_domain_shutdown :: XcHandle -- ^ Handle to the open hypervisor interface+                       -> DomId    -- ^ Domain to shutdown+                       -> CInt     -- ^ Shutdown reason+                       -> IO CInt  -- ^ 0 if success, -1 if error++-- | This function will destroy a domain. Destroying a domain removes the domain+-- completely from memory. This function should be called after sending the+-- domain a SHUTDOWN control message to free up the domain resources.+foreign import ccall unsafe "xenctrl.h xc_domain_destroy"+    xc_domain_destroy :: XcHandle -- ^ Handle to the open hypervisor interface+                      -> DomId    -- ^ Domain to destroy+                      -> IO CInt  -- ^ 0 if success, -1 if error

@@ -5,33 +5,47 @@ -- error codes and @errno@.  module System.Xen.Mid-    ( interfaceOpen+    (+    -- * Interface+      interfaceOpen     , interfaceClose+    -- * Domain     , domainGetInfo+    -- ** Domain pause+    , domainPause+    , domainUnpause+    -- ** Domain powerstate+    , domainShutdown+    , domainDestroy     ) where  #include <xenctrl.h> -import Control.Monad (void, when, forM)+import Prelude hiding (sequence)++import Control.Applicative (Alternative(..), pure)+import Control.Monad (void, when)+import Data.Traversable (Traversable(sequenceA)) import Foreign.Marshal.Alloc (allocaBytes)-import Foreign.Storable (peekElemOff, sizeOf)+import Foreign.Storable (peekElemOff, peek, poke, sizeOf)+import Foreign.Ptr (castPtr)  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)+import System.Xen.Types (XcHandle(..), DomId(..), DomainShutdownReason, DomainInfo)+import qualified System.Xen.Low as Low  -- | Open the connection to the hypervisor interface, can fail with -- 'System.Xen.Errors.XcHandleOpenError'. interfaceOpen :: MonadIO m => m XcHandle interfaceOpen = liftIO $ do #if XEN_SYSCTL_INTERFACE_VERSION == 8-    i@(XcHandle ptr) <- xc_interface_open 0 0 0+    i@(XcHandle ptr) <- Low.xc_interface_open 0 0 0     when (ptr `elem` [-1, 0]) $ getErrno >>= throwM . XcHandleOpenError #elif XEN_SYSCTL_INTERFACE_VERSION == 6-    i@(XcHandle h) <- xc_interface_open+    i@(XcHandle h) <- Low.xc_interface_open     when (h == -1) $ getErrno >>= throwM . XcHandleOpenError #endif     return i@@ -39,18 +53,46 @@ -- | 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+interfaceClose = void . liftIO . Low.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 :: (MonadIO m, Alternative t, Traversable t) => XcHandle -> m (t DomainInfo) domainGetInfo handle = liftIO $ allocaBytes size $ \ptr -> do-     wrote <- fmap fromIntegral $ xc_domain_getinfo handle (dom0) count ptr+     wrote <- fmap fromIntegral $ Low.xc_domain_getinfo handle (dom0) count ptr      when (wrote == -1) $ getErrno >>= throwM . DomainGetInfoError-     forM [0 .. wrote - 1] $ peekElemOff ptr+     sequenceA $ generateA wrote $ peekElemOff ptr   where     dom0 = DomId 0     count :: Num a => a     count = 1024     size = count * sizeOf (undefined :: DomainInfo)+    generateA c = go empty c c+      where+        go t 0 _ _ = t+        go t n l a = n `seq` go (pure (a (l - n)) <|> t) l (n - 1) a++-- | Pause domain. A paused domain still exists in memory+-- however it does not receive any timeslices from the hypervisor.+domainPause :: MonadIO m => DomId -> XcHandle -> m Bool+domainPause domid handle = liftIO $ fmap (== 0) $ Low.xc_domain_pause handle domid++-- | Unpause a domain. The domain should have been previously paused.+domainUnpause :: MonadIO m => DomId -> XcHandle -> m Bool+domainUnpause domid handle = liftIO $ fmap (== 0) $ Low.xc_domain_unpause handle domid++-- | Shutdown domain. This is intended for use in fully-virtualized domains where+-- this operation is analogous to the sched_op operations in a paravirtualized domain.+domainShutdown :: MonadIO m => DomId -> DomainShutdownReason -> XcHandle -> m Bool+domainShutdown domid reason handle = liftIO $ fmap (== 0) $ allocaBytes size $ \ptr -> do+    poke ptr reason+    intReason <- peek $ castPtr ptr+    Low.xc_domain_shutdown handle domid intReason+  where+    size = sizeOf (undefined :: DomainShutdownReason)++-- | Destroy a domain.  Destroying a domain removes the domain completely from memory.+-- This function should be called after 'domainShutdown' to free up the domain resources.+domainDestroy :: MonadIO m => DomId -> XcHandle -> m Bool+domainDestroy domid handle = liftIO $ fmap (== 0) $ Low.xc_domain_destroy handle domid

@@ -22,7 +22,6 @@ import Control.Applicative ((<$>)) import Data.Bits (testBit, bit, (.|.)) import Data.Maybe (catMaybes)-import Data.Foldable (foldl) import Data.Word (Word32, Word64) import Foreign.C (CInt(..), CUInt(..)) #if XEN_SYSCTL_INTERFACE_VERSION == 8@@ -77,8 +76,8 @@ data DomainInfo = DomainInfo     { domainInfoId                  :: {-# UNPACK #-} !DomId     , domainInfoSsidRef             :: {-# UNPACK #-} !Word32-    , domainInfoFlags               :: BitSet DomainFlag-    , domainInfoShutdownReason      :: Maybe DomainShutdownReason+    , domainInfoFlags               :: !(BitSet DomainFlag)+    , domainInfoShutdownReason      :: !(Maybe DomainShutdownReason)     , domainInfoNumberOfPages       :: {-# UNPACK #-} !Word32 #if XEN_SYSCTL_INTERFACE_VERSION == 8     , domainInfoNumberOfSharedPages :: {-# UNPACK #-} !Word32@@ -154,7 +153,7 @@         #{poke xc_dominfo_t, domid} ptr domainInfoId         #{poke xc_dominfo_t, ssidref} ptr domainInfoSsidRef         let off = sizeOf domainInfoId + sizeOf domainInfoSsidRef-        let flags :: CUInt = foldl (\a b -> a .|. bit (fromEnum b)) 0 domainInfoFlags+        let flags :: CUInt = BitSet.foldl' (\a b -> a .|. bit (fromEnum b)) 0 domainInfoFlags         pokeByteOff ptr off flags         case domainInfoShutdownReason of             Nothing -> return ()

@@ -1,10 +1,10 @@ module Main where -import Test.Framework (defaultMain)+import Test.Tasty (defaultMain, testGroup)  import qualified System.Xen.Types.Tests  main :: IO ()-main = defaultMain+main = defaultMain $ testGroup "Tests"     [ System.Xen.Types.Tests.tests     ]