packages feed

Win32-services 0.2.3.1 → 0.2.4

raw patch · 11 files changed

+606/−600 lines, 11 filesdep ~Win32dep ~errors

Dependency ranges changed: Win32, errors

Files

Win32-services.cabal view
@@ -1,6 +1,6 @@ name:           Win32-services
 category:       System
-version:        0.2.3.1
+version:        0.2.4
 cabal-version:  >= 1.14
 build-type:     Simple
 author:         Michael Steele
@@ -10,7 +10,7 @@ bug-reports:    http://github.com/mikesteele81/win32-services/issues
 license:        BSD3
 license-file:   LICENSE
-tested-with:    GHC == 7.6.3
+tested-with:    GHC == 7.8.2
 stability:      provisional
 synopsis:       Windows service applications
 description:
@@ -106,9 +106,9 @@   location: git://github.com/mikesteele81/win32-services.git
 
 library
-  build-depends: base             >= 4.5 && < 4.8
-               , errors
-               , Win32
+  build-depends: base   >= 4.5 && < 4.8
+               , errors >= 1.4 && < 1.5
+               , Win32  >= 2.2 && < 2.4
   default-language: Haskell2010
   ghc-options:     -Wall
   hs-source-dirs: src
changelog view
@@ -1,5 +1,11 @@ # 0.2 series
 
+## 0.2.4
+
+* bug fix: eRROR_SERVICE_SPECIFIC_ERROR was mapped to the wrong code.
+
+* Add upper-version bounds to build dependencies.
+
 ## 0.2.3
 
 * Update library dependencies to support GHC 7.8.
src/System/Win32/SystemServices/Services.hs view
@@ -1,170 +1,170 @@-module System.Win32.SystemServices.Services-    ( HandlerFunction-    , ServiceMainFunction-    , SERVICE_ACCEPT (..)-    , SERVICE_CONTROL (..)-    , SERVICE_STATE (..)-    , SERVICE_STATUS (..)-    , SERVICE_TYPE (..)-    , nO_ERROR-    , eRROR_SERVICE_SPECIFIC_ERROR-    , queryServiceStatus-    , setServiceStatus-    , startServiceCtrlDispatcher-    ) where--import Control.Exception-import Control.Monad.Fix-import Foreign-import System.Win32.Types--import System.Win32.SystemServices.Services.Raw-import System.Win32.SystemServices.Services.SERVICE_ACCEPT-import System.Win32.SystemServices.Services.SERVICE_CONTROL-import qualified System.Win32.SystemServices.Services.SERVICE_CONTROL as SC-import System.Win32.SystemServices.Services.SERVICE_STATE-import System.Win32.SystemServices.Services.SERVICE_STATUS-import System.Win32.SystemServices.Services.SERVICE_TABLE_ENTRY-import System.Win32.SystemServices.Services.SERVICE_TYPE-import System.Win32.SystemServices.Services.Types---- | A handler function is registered with the service dispatcher thread---   from a 'ServiceMainFunction'. The first argument is a 'HANDLE' returned---   from calling 'registerServiceCtrlHandler'. The second argument represents---   the command this service has been directed to perform.-type HandlerFunction = HANDLE -> SERVICE_CONTROL -> IO Bool---- | The service dispatcher thread will call each function of this type that---   you provide. The first argument will be the name of the service. Any---   additional command-line parameters will appear in the second argument.------   Each of these functions should call 'registerServiceCtrlHandler' to---   register a function to handle incoming commands. It should then set---   the service's status to 'START_PENDING', and specify that no controls---   will be accepted. At this point the function may perform any other---   initialization steps before setting the service's status to---   'RUNNING'. All of this should take no more than 100ms.-type ServiceMainFunction = String -> [String] -> HANDLE -> IO ()---- |Retrieves the current status of the specified service.-queryServiceStatus :: HANDLE-    -- ^ MSDN documentation: A handle to the service. This handle is returned-    -- by the OpenService or the CreateService function, and it must have the-    -- SERVICE_QUERY_STATUS access right. For more information, see Service-    -- Security and Access Rights.-    -> IO SERVICE_STATUS-    -- ^ This function will raise an exception if the Win32 call returned an-    -- error condition.-queryServiceStatus h = alloca $ \pStatus -> do-    failIfFalse_ (unwords ["QueryServiceStatus"])-        $ c_QueryServiceStatus h pStatus-    peek pStatus---- | Register an handler function to be called whenever the operating system--- receives service control messages.-registerServiceCtrlHandlerEx :: String-    -- ^ The name of the service. According to MSDN documentation this-    -- argument is unused in WIN32_OWN_PROCESS type services, which is the-    -- only type supported by this binding. Even so, it is recommended-    -- that the name of the service be used.-    ---    -- MSDN description: The name of the service run by the calling thread.-    -- This is the service name that the service control program specified in-    -- the CreateService function when creating the service.-    -> HandlerFunction-    -- ^ A Handler function to be called in response to service control-    -- messages. Behind the scenes this is translated into a "HandlerEx" type-    -- handler.-    -> IO (HANDLE, LPHANDLER_FUNCTION_EX)-    -- ^ The returned handle may be used in calls to SetServiceStatus. For-    -- convenience Handler functions also receive a handle for the service.-registerServiceCtrlHandlerEx str handler =-    withTString str $ \lptstr ->-    -- use 'ret' instead of (h', _) to avoid divergence.-    mfix $ \ret -> do-    fpHandler <- handlerToFunPtr $ toHandlerEx (fst ret) handler-    h <- failIfNull (unwords ["RegisterServiceCtrlHandlerEx", str])-        $ c_RegisterServiceCtrlHandlerEx lptstr fpHandler nullPtr-    return (h, fpHandler)---- |Updates the service control manager's status information for the calling--- service.-setServiceStatus :: HANDLE-    -- ^ MSDN documentation: A handle to the status information structure for-    -- the current service. This handle is returned by the-    -- RegisterServiceCtrlHandlerEx function.-    -> SERVICE_STATUS-    -- ^ MSDN documentation: A pointer to the SERVICE_STATUS structure the-    -- contains the latest status information for the calling service.-    -> IO ()-    -- ^ This function will raise an exception if the Win32 call returned an-    -- error condition.-setServiceStatus h status =-    with status $ \pStatus -> do-    failIfFalse_ (unwords ["SetServiceStatus", show h, show status])-        $ c_SetServiceStatus h pStatus---- |Register a callback function to initialize the service, which will be--- called by the operating system immediately. startServiceCtrlDispatcher--- will block until the provided callback function returns.------ MSDN documentation: Connects the main thread of a service process to the--- service control manager, which causes the thread to be the service control--- dispatcher thread for the calling process.-startServiceCtrlDispatcher :: String-    -- ^ The name of the service. According to MSDN documentation this-    -- argument is unused in WIN32_OWN_PROCESS type services, which is the-    -- only type supported by this binding. Even so, it is recommended-    -- that the name of the service be used.-    ---    -- MSDN description: The name of the service run by the calling thread.-    -- This is the service name that the service control program specified in-    -- the CreateService function when creating the service.-    -> DWORD-    -> HandlerFunction-    -> ServiceMainFunction-    -- ^ This is a callback function that will be called by the operating-    -- system whenever the service is started. It should perform service-    -- initialization including the registration of a handler function.-    -- MSDN documentation gives conflicting advice as to whether this function-    -- should return before the service has entered the stopped state.-    -- In the official example the service main function blocks until the-    -- service is ready to stop.-    -> IO ()-    -- ^ An exception will be raised if the underlying Win32 call returns an-    -- error condition.-startServiceCtrlDispatcher name wh handler main =-    withTString name $ \lptstr ->-    bracket (toSMF main handler wh >>= smfToFunPtr) freeHaskellFunPtr $ \fpMain ->-    withArray [SERVICE_TABLE_ENTRY lptstr fpMain, nullSTE] $ \pSTE ->-    failIfFalse_ (unwords ["StartServiceCtrlDispatcher", name]) $ do-    c_StartServiceCtrlDispatcher pSTE--toSMF :: ServiceMainFunction -> HandlerFunction -> DWORD -> IO SERVICE_MAIN_FUNCTION-toSMF f handler wh = return $ \len pLPTSTR -> do-    lptstrx <- peekArray (fromIntegral len) pLPTSTR-    args <- mapM peekTString lptstrx-    -- MSDN guarantees args will have at least 1 member.-    let name = head args-    (h, fpHandler) <- registerServiceCtrlHandlerEx name handler-    setServiceStatus h $ SERVICE_STATUS WIN32_OWN_PROCESS START_PENDING [] nO_ERROR 0 0 wh-    f name (tail args) h-    freeHaskellFunPtr fpHandler---- This was originally written with older style handle functions in mind.--- I'm now using HandlerEx style functions, and need to add support for--- the extra parameters here.-toHandlerEx :: HANDLE -> HandlerFunction -> HANDLER_FUNCTION_EX-toHandlerEx h f = \dwControl _ _ _ ->-    case SC.fromDWORD dwControl of-      Right control -> do-          handled <- f h control-          case control of-            INTERROGATE -> return nO_ERROR-            -- If we ever support extended control codes this will have to-            -- change. see "Dev Center - Desktop > Docs > Desktop app-            -- development documentation > System Services > Services >-            -- Service Reference > Service Functions > HandlerEx".-            _ -> return $ if handled then nO_ERROR-                                     else eRROR_CALL_NOT_IMPLEMENTED-      Left _ -> return eRROR_CALL_NOT_IMPLEMENTED+module System.Win32.SystemServices.Services
+    ( HandlerFunction
+    , ServiceMainFunction
+    , SERVICE_ACCEPT (..)
+    , SERVICE_CONTROL (..)
+    , SERVICE_STATE (..)
+    , SERVICE_STATUS (..)
+    , SERVICE_TYPE (..)
+    , nO_ERROR
+    , eRROR_SERVICE_SPECIFIC_ERROR
+    , queryServiceStatus
+    , setServiceStatus
+    , startServiceCtrlDispatcher
+    ) where
+
+import Control.Exception
+import Control.Monad.Fix
+import Foreign
+import System.Win32.Types
+
+import System.Win32.SystemServices.Services.Raw
+import System.Win32.SystemServices.Services.SERVICE_ACCEPT
+import System.Win32.SystemServices.Services.SERVICE_CONTROL
+import qualified System.Win32.SystemServices.Services.SERVICE_CONTROL as SC
+import System.Win32.SystemServices.Services.SERVICE_STATE
+import System.Win32.SystemServices.Services.SERVICE_STATUS
+import System.Win32.SystemServices.Services.SERVICE_TABLE_ENTRY
+import System.Win32.SystemServices.Services.SERVICE_TYPE
+import System.Win32.SystemServices.Services.Types
+
+-- | A handler function is registered with the service dispatcher thread
+--   from a 'ServiceMainFunction'. The first argument is a 'HANDLE' returned
+--   from calling 'registerServiceCtrlHandler'. The second argument represents
+--   the command this service has been directed to perform.
+type HandlerFunction = HANDLE -> SERVICE_CONTROL -> IO Bool
+
+-- | The service dispatcher thread will call each function of this type that
+--   you provide. The first argument will be the name of the service. Any
+--   additional command-line parameters will appear in the second argument.
+--
+--   Each of these functions should call 'registerServiceCtrlHandler' to
+--   register a function to handle incoming commands. It should then set
+--   the service's status to 'START_PENDING', and specify that no controls
+--   will be accepted. At this point the function may perform any other
+--   initialization steps before setting the service's status to
+--   'RUNNING'. All of this should take no more than 100ms.
+type ServiceMainFunction = String -> [String] -> HANDLE -> IO ()
+
+-- |Retrieves the current status of the specified service.
+queryServiceStatus :: HANDLE
+    -- ^ MSDN documentation: A handle to the service. This handle is returned
+    -- by the OpenService or the CreateService function, and it must have the
+    -- SERVICE_QUERY_STATUS access right. For more information, see Service
+    -- Security and Access Rights.
+    -> IO SERVICE_STATUS
+    -- ^ This function will raise an exception if the Win32 call returned an
+    -- error condition.
+queryServiceStatus h = alloca $ \pStatus -> do
+    failIfFalse_ (unwords ["QueryServiceStatus"])
+        $ c_QueryServiceStatus h pStatus
+    peek pStatus
+
+-- | Register an handler function to be called whenever the operating system
+-- receives service control messages.
+registerServiceCtrlHandlerEx :: String
+    -- ^ The name of the service. According to MSDN documentation this
+    -- argument is unused in WIN32_OWN_PROCESS type services, which is the
+    -- only type supported by this binding. Even so, it is recommended
+    -- that the name of the service be used.
+    --
+    -- MSDN description: The name of the service run by the calling thread.
+    -- This is the service name that the service control program specified in
+    -- the CreateService function when creating the service.
+    -> HandlerFunction
+    -- ^ A Handler function to be called in response to service control
+    -- messages. Behind the scenes this is translated into a "HandlerEx" type
+    -- handler.
+    -> IO (HANDLE, LPHANDLER_FUNCTION_EX)
+    -- ^ The returned handle may be used in calls to SetServiceStatus. For
+    -- convenience Handler functions also receive a handle for the service.
+registerServiceCtrlHandlerEx str handler =
+    withTString str $ \lptstr ->
+    -- use 'ret' instead of (h', _) to avoid divergence.
+    mfix $ \ret -> do
+    fpHandler <- handlerToFunPtr $ toHandlerEx (fst ret) handler
+    h <- failIfNull (unwords ["RegisterServiceCtrlHandlerEx", str])
+        $ c_RegisterServiceCtrlHandlerEx lptstr fpHandler nullPtr
+    return (h, fpHandler)
+
+-- |Updates the service control manager's status information for the calling
+-- service.
+setServiceStatus :: HANDLE
+    -- ^ MSDN documentation: A handle to the status information structure for
+    -- the current service. This handle is returned by the
+    -- RegisterServiceCtrlHandlerEx function.
+    -> SERVICE_STATUS
+    -- ^ MSDN documentation: A pointer to the SERVICE_STATUS structure the
+    -- contains the latest status information for the calling service.
+    -> IO ()
+    -- ^ This function will raise an exception if the Win32 call returned an
+    -- error condition.
+setServiceStatus h status =
+    with status $ \pStatus -> do
+    failIfFalse_ (unwords ["SetServiceStatus", show h, show status])
+        $ c_SetServiceStatus h pStatus
+
+-- |Register a callback function to initialize the service, which will be
+-- called by the operating system immediately. startServiceCtrlDispatcher
+-- will block until the provided callback function returns.
+--
+-- MSDN documentation: Connects the main thread of a service process to the
+-- service control manager, which causes the thread to be the service control
+-- dispatcher thread for the calling process.
+startServiceCtrlDispatcher :: String
+    -- ^ The name of the service. According to MSDN documentation this
+    -- argument is unused in WIN32_OWN_PROCESS type services, which is the
+    -- only type supported by this binding. Even so, it is recommended
+    -- that the name of the service be used.
+    --
+    -- MSDN description: The name of the service run by the calling thread.
+    -- This is the service name that the service control program specified in
+    -- the CreateService function when creating the service.
+    -> DWORD
+    -> HandlerFunction
+    -> ServiceMainFunction
+    -- ^ This is a callback function that will be called by the operating
+    -- system whenever the service is started. It should perform service
+    -- initialization including the registration of a handler function.
+    -- MSDN documentation gives conflicting advice as to whether this function
+    -- should return before the service has entered the stopped state.
+    -- In the official example the service main function blocks until the
+    -- service is ready to stop.
+    -> IO ()
+    -- ^ An exception will be raised if the underlying Win32 call returns an
+    -- error condition.
+startServiceCtrlDispatcher name wh handler main =
+    withTString name $ \lptstr ->
+    bracket (toSMF main handler wh >>= smfToFunPtr) freeHaskellFunPtr $ \fpMain ->
+    withArray [SERVICE_TABLE_ENTRY lptstr fpMain, nullSTE] $ \pSTE ->
+    failIfFalse_ (unwords ["StartServiceCtrlDispatcher", name]) $ do
+    c_StartServiceCtrlDispatcher pSTE
+
+toSMF :: ServiceMainFunction -> HandlerFunction -> DWORD -> IO SERVICE_MAIN_FUNCTION
+toSMF f handler wh = return $ \len pLPTSTR -> do
+    lptstrx <- peekArray (fromIntegral len) pLPTSTR
+    args <- mapM peekTString lptstrx
+    -- MSDN guarantees args will have at least 1 member.
+    let name = head args
+    (h, fpHandler) <- registerServiceCtrlHandlerEx name handler
+    setServiceStatus h $ SERVICE_STATUS WIN32_OWN_PROCESS START_PENDING [] nO_ERROR 0 0 wh
+    f name (tail args) h
+    freeHaskellFunPtr fpHandler
+
+-- This was originally written with older style handle functions in mind.
+-- I'm now using HandlerEx style functions, and need to add support for
+-- the extra parameters here.
+toHandlerEx :: HANDLE -> HandlerFunction -> HANDLER_FUNCTION_EX
+toHandlerEx h f = \dwControl _ _ _ ->
+    case SC.fromDWORD dwControl of
+      Right control -> do
+          handled <- f h control
+          case control of
+            INTERROGATE -> return nO_ERROR
+            -- If we ever support extended control codes this will have to
+            -- change. see "Dev Center - Desktop > Docs > Desktop app
+            -- development documentation > System Services > Services >
+            -- Service Reference > Service Functions > HandlerEx".
+            _ -> return $ if handled then nO_ERROR
+                                     else eRROR_CALL_NOT_IMPLEMENTED
+      Left _ -> return eRROR_CALL_NOT_IMPLEMENTED
src/System/Win32/SystemServices/Services/Raw.hs view
@@ -1,33 +1,33 @@-{-# LANGUAGE ForeignFunctionInterface #-}--module System.Win32.SystemServices.Services.Raw where--import Foreign.Ptr (Ptr)-import System.Win32.Types--import System.Win32.SystemServices.Services.SERVICE_STATUS-import System.Win32.SystemServices.Services.SERVICE_TABLE_ENTRY-import System.Win32.SystemServices.Services.Types--foreign import stdcall "wrapper"-    smfToFunPtr :: SERVICE_MAIN_FUNCTION -> IO LPSERVICE_MAIN_FUNCTION--foreign import stdcall "wrapper"-    handlerToFunPtr :: HANDLER_FUNCTION_EX -> IO LPHANDLER_FUNCTION_EX---- BOOL WINAPI QueryServiceStatus(---   _In_   SC_HANDLE hService,---   _Out_  LPSERVICE_STATUS lpServiceStatus--- );-foreign import stdcall "windows.h QueryServiceStatus"-    c_QueryServiceStatus :: HANDLE -> Ptr SERVICE_STATUS -> IO BOOL---- I've not been able to get RegisterServiceCtrlHandler to work on Windows 7 64-bit.-foreign import stdcall "windows.h RegisterServiceCtrlHandlerExW"-    c_RegisterServiceCtrlHandlerEx :: LPTSTR -> LPHANDLER_FUNCTION_EX  -> Ptr () -> IO HANDLE--foreign import stdcall "windows.h SetServiceStatus"-    c_SetServiceStatus :: HANDLE -> Ptr SERVICE_STATUS -> IO BOOL--foreign import stdcall "windows.h StartServiceCtrlDispatcherW"-    c_StartServiceCtrlDispatcher :: Ptr SERVICE_TABLE_ENTRY -> IO BOOL+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module System.Win32.SystemServices.Services.Raw where
+
+import Foreign.Ptr (Ptr)
+import System.Win32.Types
+
+import System.Win32.SystemServices.Services.SERVICE_STATUS
+import System.Win32.SystemServices.Services.SERVICE_TABLE_ENTRY
+import System.Win32.SystemServices.Services.Types
+
+foreign import stdcall "wrapper"
+    smfToFunPtr :: SERVICE_MAIN_FUNCTION -> IO LPSERVICE_MAIN_FUNCTION
+
+foreign import stdcall "wrapper"
+    handlerToFunPtr :: HANDLER_FUNCTION_EX -> IO LPHANDLER_FUNCTION_EX
+
+-- BOOL WINAPI QueryServiceStatus(
+--   _In_   SC_HANDLE hService,
+--   _Out_  LPSERVICE_STATUS lpServiceStatus
+-- );
+foreign import stdcall "windows.h QueryServiceStatus"
+    c_QueryServiceStatus :: HANDLE -> Ptr SERVICE_STATUS -> IO BOOL
+
+-- I've not been able to get RegisterServiceCtrlHandler to work on Windows 7 64-bit.
+foreign import stdcall "windows.h RegisterServiceCtrlHandlerExW"
+    c_RegisterServiceCtrlHandlerEx :: LPTSTR -> LPHANDLER_FUNCTION_EX  -> Ptr () -> IO HANDLE
+
+foreign import stdcall "windows.h SetServiceStatus"
+    c_SetServiceStatus :: HANDLE -> Ptr SERVICE_STATUS -> IO BOOL
+
+foreign import stdcall "windows.h StartServiceCtrlDispatcherW"
+    c_StartServiceCtrlDispatcher :: Ptr SERVICE_TABLE_ENTRY -> IO BOOL
src/System/Win32/SystemServices/Services/SERVICE_ACCEPT.hs view
@@ -1,92 +1,92 @@-module System.Win32.SystemServices.Services.SERVICE_ACCEPT-    ( SERVICE_ACCEPT (..)-    , pokeServiceAccept-    , peekServiceAccept-    ) where--import Control.Applicative-import Data.Bits-import Data.Maybe-import Foreign-import System.Win32.Types (DWORD)-import Text.Printf--import Control.Error---- | The control codes the service accepts and processes in its handler---   function (See 'HandlerFunction'). By default, all services accept the---   'INTERROGATE' value. To accept the 'DEVICEEVENT' value, the service must---   register to receive device events by using the---   'registerDeviceNotification' function.-data SERVICE_ACCEPT-    -- | The service is a network component that can accept changes in its-    --   binding without being stopped and restarted. This control code allows-    --   the service to receive 'NETBINDADD', 'NETBINDREMOVE', 'NETBINDENABLE'-    --   , and 'NETBINDDISABLE' notifications.-    = ACCEPT_NETBINDCHANGE-    -- | The service can reread its startup parameters without being stopped-    --   and restarted. This control code allows the service to receive-    --   'PARAMCHANGE' notifications.-    | ACCEPT_PARAMCHANGE-    -- | The service can be paused and continued. This control code allows the-    --   service to receive 'PAUSE' and 'CONTINUE' notifications.-    | ACCEPT_PAUSE_CONTINUE-    -- | MSDN documentation says that this function is not supported on-    --   Windows Server 2003 or Windows XP/2000. The support status on other-    --   versions is unknown to me.-    ---    --   The service can perform preshutdown tasks. This control code enables-    --   the service to receive 'PRESHUTDOWN' notifications.-    --   Note that only the system can send it.-    | ACCEPT_PRESHUTDOWN-    -- | The service is notified when system shutdown occurs. This control-    --   code allows the service to receive 'SHUTDOWN' notifications. Note-    --   that only the system can send it.-    | ACCEPT_SHUTDOWN-    -- | The service can be stopped. This control code allows the service to-    --   receive 'STOP' notifications.-    | ACCEPT_STOP-    deriving (Show)--peekServiceAccept :: Ptr DWORD -> IO [SERVICE_ACCEPT]-peekServiceAccept ptr = unflag <$> peek ptr--pokeServiceAccept :: Ptr DWORD -> [SERVICE_ACCEPT] -> IO ()-pokeServiceAccept ptr sas = poke ptr . flag $ sas--toDWORD :: SERVICE_ACCEPT -> DWORD-toDWORD ACCEPT_NETBINDCHANGE  = 0x00000010-toDWORD ACCEPT_PARAMCHANGE    = 0x00000008-toDWORD ACCEPT_PAUSE_CONTINUE = 0x00000002-toDWORD ACCEPT_PRESHUTDOWN    = 0x00000100-toDWORD ACCEPT_SHUTDOWN       = 0x00000004-toDWORD ACCEPT_STOP           = 0x00000001--fromDWORD :: DWORD -> Either String SERVICE_ACCEPT-fromDWORD 0x00000010 = Right ACCEPT_NETBINDCHANGE-fromDWORD 0x00000008 = Right ACCEPT_PARAMCHANGE-fromDWORD 0x00000002 = Right ACCEPT_PAUSE_CONTINUE-fromDWORD 0x00000100 = Right ACCEPT_PRESHUTDOWN-fromDWORD 0x00000004 = Right ACCEPT_SHUTDOWN-fromDWORD 0x00000001 = Right ACCEPT_STOP-fromDWORD 0x00000020 = unsupported "SERVICE_ACCEPT_HARDWAREPROFILECHANGE"-fromDWORD 0x00000040 = unsupported "SERVICE_ACCEPT_POWEREVENT"-fromDWORD 0x00000080 = unsupported "SERVICE_ACCEPT_SESSIONCHANGE"-fromDWORD 0x00000200 = unsupported "SERVICE_ACCEPT_TIMECHANGE"-fromDWORD 0x00000400 = unsupported "SERVICE_ACCEPT_TRIGGEREVENT"-fromDWORD 0x00000800 = unsupported "SERVICE_ACCEPT_USERMODEREBOOT"-fromDWORD x = Left $ "The " ++ printf "%x" x ++ " control code is undocumented."--unsupported :: String -> Either String a-unsupported name = Left $ "The " ++ name ++ " control code is unsupported by this binding."---- | This function takes a 'DWORD' and assumes it is a flagfield. Each bit---   is masked off and converted into a value. Any failures are silently---   discarded.-unflag :: DWORD -> [SERVICE_ACCEPT]-unflag f = mapMaybe (hush . fromDWORD . (.&. f)) masks-  where-    masks = take 32 $ iterate (`shiftL` 1) 1--flag :: [SERVICE_ACCEPT] -> DWORD+module System.Win32.SystemServices.Services.SERVICE_ACCEPT
+    ( SERVICE_ACCEPT (..)
+    , pokeServiceAccept
+    , peekServiceAccept
+    ) where
+
+import Control.Applicative
+import Data.Bits
+import Data.Maybe
+import Foreign
+import System.Win32.Types (DWORD)
+import Text.Printf
+
+import Control.Error
+
+-- | The control codes the service accepts and processes in its handler
+--   function (See 'HandlerFunction'). By default, all services accept the
+--   'INTERROGATE' value. To accept the 'DEVICEEVENT' value, the service must
+--   register to receive device events by using the
+--   'registerDeviceNotification' function.
+data SERVICE_ACCEPT
+    -- | The service is a network component that can accept changes in its
+    --   binding without being stopped and restarted. This control code allows
+    --   the service to receive 'NETBINDADD', 'NETBINDREMOVE', 'NETBINDENABLE'
+    --   , and 'NETBINDDISABLE' notifications.
+    = ACCEPT_NETBINDCHANGE
+    -- | The service can reread its startup parameters without being stopped
+    --   and restarted. This control code allows the service to receive
+    --   'PARAMCHANGE' notifications.
+    | ACCEPT_PARAMCHANGE
+    -- | The service can be paused and continued. This control code allows the
+    --   service to receive 'PAUSE' and 'CONTINUE' notifications.
+    | ACCEPT_PAUSE_CONTINUE
+    -- | MSDN documentation says that this function is not supported on
+    --   Windows Server 2003 or Windows XP/2000. The support status on other
+    --   versions is unknown to me.
+    --
+    --   The service can perform preshutdown tasks. This control code enables
+    --   the service to receive 'PRESHUTDOWN' notifications.
+    --   Note that only the system can send it.
+    | ACCEPT_PRESHUTDOWN
+    -- | The service is notified when system shutdown occurs. This control
+    --   code allows the service to receive 'SHUTDOWN' notifications. Note
+    --   that only the system can send it.
+    | ACCEPT_SHUTDOWN
+    -- | The service can be stopped. This control code allows the service to
+    --   receive 'STOP' notifications.
+    | ACCEPT_STOP
+    deriving (Show)
+
+peekServiceAccept :: Ptr DWORD -> IO [SERVICE_ACCEPT]
+peekServiceAccept ptr = unflag <$> peek ptr
+
+pokeServiceAccept :: Ptr DWORD -> [SERVICE_ACCEPT] -> IO ()
+pokeServiceAccept ptr sas = poke ptr . flag $ sas
+
+toDWORD :: SERVICE_ACCEPT -> DWORD
+toDWORD ACCEPT_NETBINDCHANGE  = 0x00000010
+toDWORD ACCEPT_PARAMCHANGE    = 0x00000008
+toDWORD ACCEPT_PAUSE_CONTINUE = 0x00000002
+toDWORD ACCEPT_PRESHUTDOWN    = 0x00000100
+toDWORD ACCEPT_SHUTDOWN       = 0x00000004
+toDWORD ACCEPT_STOP           = 0x00000001
+
+fromDWORD :: DWORD -> Either String SERVICE_ACCEPT
+fromDWORD 0x00000010 = Right ACCEPT_NETBINDCHANGE
+fromDWORD 0x00000008 = Right ACCEPT_PARAMCHANGE
+fromDWORD 0x00000002 = Right ACCEPT_PAUSE_CONTINUE
+fromDWORD 0x00000100 = Right ACCEPT_PRESHUTDOWN
+fromDWORD 0x00000004 = Right ACCEPT_SHUTDOWN
+fromDWORD 0x00000001 = Right ACCEPT_STOP
+fromDWORD 0x00000020 = unsupported "SERVICE_ACCEPT_HARDWAREPROFILECHANGE"
+fromDWORD 0x00000040 = unsupported "SERVICE_ACCEPT_POWEREVENT"
+fromDWORD 0x00000080 = unsupported "SERVICE_ACCEPT_SESSIONCHANGE"
+fromDWORD 0x00000200 = unsupported "SERVICE_ACCEPT_TIMECHANGE"
+fromDWORD 0x00000400 = unsupported "SERVICE_ACCEPT_TRIGGEREVENT"
+fromDWORD 0x00000800 = unsupported "SERVICE_ACCEPT_USERMODEREBOOT"
+fromDWORD x = Left $ "The " ++ printf "%x" x ++ " control code is undocumented."
+
+unsupported :: String -> Either String a
+unsupported name = Left $ "The " ++ name ++ " control code is unsupported by this binding."
+
+-- | This function takes a 'DWORD' and assumes it is a flagfield. Each bit
+--   is masked off and converted into a value. Any failures are silently
+--   discarded.
+unflag :: DWORD -> [SERVICE_ACCEPT]
+unflag f = mapMaybe (hush . fromDWORD . (.&. f)) masks
+  where
+    masks = take 32 $ iterate (`shiftL` 1) 1
+
+flag :: [SERVICE_ACCEPT] -> DWORD
 flag fs = foldl (\flag' f -> flag' .|. toDWORD f) 0 fs
src/System/Win32/SystemServices/Services/SERVICE_CONTROL.hs view
@@ -1,68 +1,68 @@-module System.Win32.SystemServices.Services.SERVICE_CONTROL-    ( SERVICE_CONTROL (..)-    , peekServiceControl-    , pokeServiceControl-    , fromDWORD-    ) where--import Foreign-import System.Win32.Types (DWORD)-import Text.Printf--import Control.Error---- | A SERVICE_CONTROL is used in Handler functions. All control codes are---   defined here, but some can only be used with a 'HandlerEx' callback.---   Use 'convertSuccess' to translate from a 'SERVICE_CONTROL' to a 'DWORD'.---   Use 'convertAttempt' to translate from a 'DWORD' to a 'SERVICE_CONTROL'.-data SERVICE_CONTROL = CONTINUE | INTERROGATE | NETBINDADD | NETBINDDISABLE-    | NETBINDENABLE | NETBINDREMOVE | PARAMCHANGE | PAUSE-    | PRESHUTDOWN | SHUTDOWN | STOP-    deriving (Show)--peekServiceControl :: Ptr DWORD -> IO SERVICE_CONTROL-peekServiceControl ptr = runScript $ do-    dword <- scriptIO $ peek ptr-    hoistEither $ fromDWORD dword--pokeServiceControl :: Ptr DWORD -> SERVICE_CONTROL -> IO ()-pokeServiceControl ptr sc = poke ptr . toDWORD $ sc--toDWORD :: SERVICE_CONTROL -> DWORD-toDWORD CONTINUE       = 0x00000003-toDWORD INTERROGATE    = 0x00000004-toDWORD NETBINDADD     = 0x00000007-toDWORD NETBINDDISABLE = 0x0000000A-toDWORD NETBINDENABLE  = 0x00000009-toDWORD NETBINDREMOVE  = 0x00000008-toDWORD PARAMCHANGE    = 0x00000006-toDWORD PAUSE          = 0x00000002-toDWORD PRESHUTDOWN    = 0x0000000F-toDWORD SHUTDOWN       = 0x00000005-toDWORD STOP           = 0x00000001--fromDWORD :: DWORD -> Either String SERVICE_CONTROL-fromDWORD 0x00000003 = Right CONTINUE-fromDWORD 0x00000004 = Right INTERROGATE-fromDWORD 0x00000007 = Right NETBINDADD-fromDWORD 0x0000000A = Right NETBINDDISABLE-fromDWORD 0x00000009 = Right NETBINDENABLE-fromDWORD 0x00000008 = Right NETBINDREMOVE-fromDWORD 0x00000006 = Right PARAMCHANGE-fromDWORD 0x00000002 = Right PAUSE-fromDWORD 0x0000000F = Right PRESHUTDOWN-fromDWORD 0x00000005 = Right SHUTDOWN-fromDWORD 0x00000001 = Right STOP-fromDWORD 0x0000000B = unsupported "SERVICE_CONTROL_DEVICEEVENT"-fromDWORD 0x0000000C = unsupported "SERVICE_CONTROL_HARDWAREPROFILECHANGE"-fromDWORD 0x0000000D = unsupported "SERVICE_CONTROL_POWEREVENT"-fromDWORD 0x0000000E = unsupported "SERVICE_CONTROL_SESSIONCHANGE"-fromDWORD 0x00000010 = unsupported "SERVICE_CONTROL_TIMECHANGE"-fromDWORD 0x00000020 = unsupported "SERVICE_CONTROL_TRIGGEREVENT"-fromDWORD 0x00000040 = unsupported "SERVICE_CONTROL_USERMODEREBOOT"-fromDWORD x-    | x >= 128 && x <= 255 = Left "user defined control codes are unsupported by this binding."-    | otherwise = Left $ "The " ++ printf "%x" x ++ " control code is undocumented."--unsupported :: String -> Either String a-unsupported name = Left $ "The " ++ name ++ " control code is unsupported by this binding."+module System.Win32.SystemServices.Services.SERVICE_CONTROL
+    ( SERVICE_CONTROL (..)
+    , peekServiceControl
+    , pokeServiceControl
+    , fromDWORD
+    ) where
+
+import Foreign
+import System.Win32.Types (DWORD)
+import Text.Printf
+
+import Control.Error
+
+-- | A SERVICE_CONTROL is used in Handler functions. All control codes are
+--   defined here, but some can only be used with a 'HandlerEx' callback.
+--   Use 'convertSuccess' to translate from a 'SERVICE_CONTROL' to a 'DWORD'.
+--   Use 'convertAttempt' to translate from a 'DWORD' to a 'SERVICE_CONTROL'.
+data SERVICE_CONTROL = CONTINUE | INTERROGATE | NETBINDADD | NETBINDDISABLE
+    | NETBINDENABLE | NETBINDREMOVE | PARAMCHANGE | PAUSE
+    | PRESHUTDOWN | SHUTDOWN | STOP
+    deriving (Show)
+
+peekServiceControl :: Ptr DWORD -> IO SERVICE_CONTROL
+peekServiceControl ptr = runScript $ do
+    dword <- scriptIO $ peek ptr
+    hoistEither $ fromDWORD dword
+
+pokeServiceControl :: Ptr DWORD -> SERVICE_CONTROL -> IO ()
+pokeServiceControl ptr sc = poke ptr . toDWORD $ sc
+
+toDWORD :: SERVICE_CONTROL -> DWORD
+toDWORD CONTINUE       = 0x00000003
+toDWORD INTERROGATE    = 0x00000004
+toDWORD NETBINDADD     = 0x00000007
+toDWORD NETBINDDISABLE = 0x0000000A
+toDWORD NETBINDENABLE  = 0x00000009
+toDWORD NETBINDREMOVE  = 0x00000008
+toDWORD PARAMCHANGE    = 0x00000006
+toDWORD PAUSE          = 0x00000002
+toDWORD PRESHUTDOWN    = 0x0000000F
+toDWORD SHUTDOWN       = 0x00000005
+toDWORD STOP           = 0x00000001
+
+fromDWORD :: DWORD -> Either String SERVICE_CONTROL
+fromDWORD 0x00000003 = Right CONTINUE
+fromDWORD 0x00000004 = Right INTERROGATE
+fromDWORD 0x00000007 = Right NETBINDADD
+fromDWORD 0x0000000A = Right NETBINDDISABLE
+fromDWORD 0x00000009 = Right NETBINDENABLE
+fromDWORD 0x00000008 = Right NETBINDREMOVE
+fromDWORD 0x00000006 = Right PARAMCHANGE
+fromDWORD 0x00000002 = Right PAUSE
+fromDWORD 0x0000000F = Right PRESHUTDOWN
+fromDWORD 0x00000005 = Right SHUTDOWN
+fromDWORD 0x00000001 = Right STOP
+fromDWORD 0x0000000B = unsupported "SERVICE_CONTROL_DEVICEEVENT"
+fromDWORD 0x0000000C = unsupported "SERVICE_CONTROL_HARDWAREPROFILECHANGE"
+fromDWORD 0x0000000D = unsupported "SERVICE_CONTROL_POWEREVENT"
+fromDWORD 0x0000000E = unsupported "SERVICE_CONTROL_SESSIONCHANGE"
+fromDWORD 0x00000010 = unsupported "SERVICE_CONTROL_TIMECHANGE"
+fromDWORD 0x00000020 = unsupported "SERVICE_CONTROL_TRIGGEREVENT"
+fromDWORD 0x00000040 = unsupported "SERVICE_CONTROL_USERMODEREBOOT"
+fromDWORD x
+    | x >= 128 && x <= 255 = Left "user defined control codes are unsupported by this binding."
+    | otherwise = Left $ "The " ++ printf "%x" x ++ " control code is undocumented."
+
+unsupported :: String -> Either String a
+unsupported name = Left $ "The " ++ name ++ " control code is unsupported by this binding."
src/System/Win32/SystemServices/Services/SERVICE_STATE.hs view
@@ -1,56 +1,56 @@-module System.Win32.SystemServices.Services.SERVICE_STATE-    ( SERVICE_STATE (..)-    , nO_ERROR-    , eRROR_CALL_NOT_IMPLEMENTED-    , eRROR_SERVICE_SPECIFIC_ERROR-    , peekServiceState-    , pokeServiceState-    ) where--import Foreign-import System.Win32.Types-import Text.Printf--import Control.Error--nO_ERROR :: ErrCode-nO_ERROR = 0--eRROR_CALL_NOT_IMPLEMENTED :: ErrCode-eRROR_CALL_NOT_IMPLEMENTED = 0x78--eRROR_SERVICE_SPECIFIC_ERROR :: ErrCode-eRROR_SERVICE_SPECIFIC_ERROR = 0x429---- | The current state of a service.-data SERVICE_STATE = CONTINUE_PENDING | PAUSE_PENDING | PAUSED | RUNNING-    | START_PENDING | STOP_PENDING | STOPPED-    deriving (Eq, Show)--fromDWORD :: DWORD -> Either String SERVICE_STATE-fromDWORD 5 = Right CONTINUE_PENDING-fromDWORD 6 = Right PAUSE_PENDING-fromDWORD 7 = Right PAUSED-fromDWORD 4 = Right RUNNING-fromDWORD 2 = Right START_PENDING-fromDWORD 3 = Right STOP_PENDING-fromDWORD 1 = Right STOPPED-fromDWORD x = Left $ "Unable to interpret " ++ printf "%x" x-                  ++ " as a SERVICE_STATE."--toDWORD :: SERVICE_STATE -> DWORD-toDWORD STOPPED          = 0x00000001-toDWORD START_PENDING    = 0x00000002-toDWORD STOP_PENDING     = 0x00000003-toDWORD RUNNING          = 0x00000004-toDWORD CONTINUE_PENDING = 0x00000005-toDWORD PAUSE_PENDING    = 0x00000006-toDWORD PAUSED           = 0x00000007--peekServiceState :: Ptr DWORD -> Script SERVICE_STATE-peekServiceState ptr = do-    dword <- scriptIO $ peek ptr-    hoistEither $ fromDWORD dword--pokeServiceState :: Ptr DWORD -> SERVICE_STATE -> IO ()-pokeServiceState ptr sc = poke ptr . toDWORD $ sc+module System.Win32.SystemServices.Services.SERVICE_STATE
+    ( SERVICE_STATE (..)
+    , nO_ERROR
+    , eRROR_CALL_NOT_IMPLEMENTED
+    , eRROR_SERVICE_SPECIFIC_ERROR
+    , peekServiceState
+    , pokeServiceState
+    ) where
+
+import Foreign
+import System.Win32.Types
+import Text.Printf
+
+import Control.Error
+
+nO_ERROR :: ErrCode
+nO_ERROR = 0
+
+eRROR_CALL_NOT_IMPLEMENTED :: ErrCode
+eRROR_CALL_NOT_IMPLEMENTED = 0x78
+
+eRROR_SERVICE_SPECIFIC_ERROR :: ErrCode
+eRROR_SERVICE_SPECIFIC_ERROR = 0x42a
+
+-- | The current state of a service.
+data SERVICE_STATE = CONTINUE_PENDING | PAUSE_PENDING | PAUSED | RUNNING
+    | START_PENDING | STOP_PENDING | STOPPED
+    deriving (Eq, Show)
+
+fromDWORD :: DWORD -> Either String SERVICE_STATE
+fromDWORD 5 = Right CONTINUE_PENDING
+fromDWORD 6 = Right PAUSE_PENDING
+fromDWORD 7 = Right PAUSED
+fromDWORD 4 = Right RUNNING
+fromDWORD 2 = Right START_PENDING
+fromDWORD 3 = Right STOP_PENDING
+fromDWORD 1 = Right STOPPED
+fromDWORD x = Left $ "Unable to interpret " ++ printf "%x" x
+                  ++ " as a SERVICE_STATE."
+
+toDWORD :: SERVICE_STATE -> DWORD
+toDWORD STOPPED          = 0x00000001
+toDWORD START_PENDING    = 0x00000002
+toDWORD STOP_PENDING     = 0x00000003
+toDWORD RUNNING          = 0x00000004
+toDWORD CONTINUE_PENDING = 0x00000005
+toDWORD PAUSE_PENDING    = 0x00000006
+toDWORD PAUSED           = 0x00000007
+
+peekServiceState :: Ptr DWORD -> Script SERVICE_STATE
+peekServiceState ptr = do
+    dword <- scriptIO $ peek ptr
+    hoistEither $ fromDWORD dword
+
+pokeServiceState :: Ptr DWORD -> SERVICE_STATE -> IO ()
+pokeServiceState ptr sc = poke ptr . toDWORD $ sc
src/System/Win32/SystemServices/Services/SERVICE_STATUS.hs view
@@ -1,83 +1,83 @@-module System.Win32.SystemServices.Services.SERVICE_STATUS where--import Control.Applicative-import Foreign-import System.Win32.Types--import Control.Error--import System.Win32.SystemServices.Services.SERVICE_ACCEPT-import System.Win32.SystemServices.Services.SERVICE_STATE-import System.Win32.SystemServices.Services.SERVICE_TYPE---- | Contains status information for a service.-data SERVICE_STATUS = SERVICE_STATUS-    { serviceType             :: SERVICE_TYPE-    -- ^ The type of service. This binding only supports the WIN32_OWN_PROCESS-    -- type.-    , currentState            :: SERVICE_STATE-    -- ^ The current state of the service.-    , controlsAccepted        :: [SERVICE_ACCEPT]-    -- ^ See 'SERVICE_ACCEPT' for details on this field.-    , win32ExitCode           :: DWORD-    -- ^ The error code the service uses to report an error that occurs when-    --   it is starting or stopping. To return an error code specific to the-    --   service, the service must set this value to-    --   'eRROR_SERVICE_SPECIFIC_ERROR' to indicate that the-    --   'serviceSpecificExitCode' member contains the error code. The service-    --   should set this value to 'nO_ERROR' when it is running and on normal-    --   termination.-    , serviceSpecificExitCode :: DWORD-    -- ^ A service-specific error code that the service returns when an error-    -- occurs while the service is starting or stopping. This value is-    -- ignored unless the 'win32ExitCode' member is set to-    -- 'eRROR_SERVICE_SPECIFIC_ERROR'.-    ---    -- This binding does not support service-specific error codes.-    , checkPoint              :: DWORD-    -- ^ The check-point value the service increments periodically to report-    --   its progress during a lengthy start, stop, pause, or continue-    --   operation. For example, the service should increment this value as it-    --   completes each step of its initialization when it is starting up. The-    --   user interface program that invoked the operation on the service uses-    --   this value to track the progress of the service during a lengthy-    --   operation. This value is not valid and should be zero when the-    --   service does not have a start, stop, pause, or continue operation-    --   pending.-    , waitHint                :: DWORD-    -- ^ The estimated time required for a pending start, stop, pause, or-    --   continue operation, in milliseconds. Before the specified amount of-    --   time has elapsed, the service should make its next call to the-    --   SetServiceStatus function with either an incremented dwCheckPoint-    --   value or a change in 'currentState'. If the amount of time specified-    --   by 'waitHint' passes, and 'checkPoint' has not been incremented or-    --   'currentState' has not changed, the service control manager or-    --   service control program can assume that an error has occurred and the-    --   service should be stopped. However, if the service shares a process-    --   with other services, the service control manager cannot terminate the-    --   service application because it would have to terminate the other-    --   services sharing the process as well.-    } deriving (Show)--instance Storable SERVICE_STATUS where-  sizeOf _ = 28-  alignment _ = 4-  peek ptr = SERVICE_STATUS <$> (runScript . peekServiceType) pST-      <*> (runScript . peekServiceState) pCS <*> peekServiceAccept pCA-      <*> peek pEC <*> peek pSSEC <*> peek pCP <*> peek pWH-    where-      pST = castPtr ptr-      pCS = castPtr ptr `plusPtr` 4-      pCA = castPtr ptr `plusPtr` 8-      pEC = castPtr ptr `plusPtr` 12-      pSSEC = castPtr ptr `plusPtr` 16-      pCP = castPtr ptr `plusPtr` 20-      pWH = castPtr ptr `plusPtr` 24-  poke ptr (SERVICE_STATUS st cs ca ec ssec cp wh) = do-    pokeServiceType (castPtr ptr) st-    pokeServiceState (castPtr ptr `plusPtr` 4) cs-    pokeServiceAccept (castPtr ptr `plusPtr` 8)  ca-    poke (castPtr ptr `plusPtr` 12) ec-    poke (castPtr ptr `plusPtr` 16) ssec-    poke (castPtr ptr `plusPtr` 20) cp-    poke (castPtr ptr `plusPtr` 24) wh+module System.Win32.SystemServices.Services.SERVICE_STATUS where
+
+import Control.Applicative
+import Foreign
+import System.Win32.Types
+
+import Control.Error
+
+import System.Win32.SystemServices.Services.SERVICE_ACCEPT
+import System.Win32.SystemServices.Services.SERVICE_STATE
+import System.Win32.SystemServices.Services.SERVICE_TYPE
+
+-- | Contains status information for a service.
+data SERVICE_STATUS = SERVICE_STATUS
+    { serviceType             :: SERVICE_TYPE
+    -- ^ The type of service. This binding only supports the WIN32_OWN_PROCESS
+    -- type.
+    , currentState            :: SERVICE_STATE
+    -- ^ The current state of the service.
+    , controlsAccepted        :: [SERVICE_ACCEPT]
+    -- ^ See 'SERVICE_ACCEPT' for details on this field.
+    , win32ExitCode           :: DWORD
+    -- ^ The error code the service uses to report an error that occurs when
+    --   it is starting or stopping. To return an error code specific to the
+    --   service, the service must set this value to
+    --   'eRROR_SERVICE_SPECIFIC_ERROR' to indicate that the
+    --   'serviceSpecificExitCode' member contains the error code. The service
+    --   should set this value to 'nO_ERROR' when it is running and on normal
+    --   termination.
+    , serviceSpecificExitCode :: DWORD
+    -- ^ A service-specific error code that the service returns when an error
+    -- occurs while the service is starting or stopping. This value is
+    -- ignored unless the 'win32ExitCode' member is set to
+    -- 'eRROR_SERVICE_SPECIFIC_ERROR'.
+    --
+    -- This binding does not support service-specific error codes.
+    , checkPoint              :: DWORD
+    -- ^ The check-point value the service increments periodically to report
+    --   its progress during a lengthy start, stop, pause, or continue
+    --   operation. For example, the service should increment this value as it
+    --   completes each step of its initialization when it is starting up. The
+    --   user interface program that invoked the operation on the service uses
+    --   this value to track the progress of the service during a lengthy
+    --   operation. This value is not valid and should be zero when the
+    --   service does not have a start, stop, pause, or continue operation
+    --   pending.
+    , waitHint                :: DWORD
+    -- ^ The estimated time required for a pending start, stop, pause, or
+    --   continue operation, in milliseconds. Before the specified amount of
+    --   time has elapsed, the service should make its next call to the
+    --   SetServiceStatus function with either an incremented dwCheckPoint
+    --   value or a change in 'currentState'. If the amount of time specified
+    --   by 'waitHint' passes, and 'checkPoint' has not been incremented or
+    --   'currentState' has not changed, the service control manager or
+    --   service control program can assume that an error has occurred and the
+    --   service should be stopped. However, if the service shares a process
+    --   with other services, the service control manager cannot terminate the
+    --   service application because it would have to terminate the other
+    --   services sharing the process as well.
+    } deriving (Show)
+
+instance Storable SERVICE_STATUS where
+  sizeOf _ = 28
+  alignment _ = 4
+  peek ptr = SERVICE_STATUS <$> (runScript . peekServiceType) pST
+      <*> (runScript . peekServiceState) pCS <*> peekServiceAccept pCA
+      <*> peek pEC <*> peek pSSEC <*> peek pCP <*> peek pWH
+    where
+      pST = castPtr ptr
+      pCS = castPtr ptr `plusPtr` 4
+      pCA = castPtr ptr `plusPtr` 8
+      pEC = castPtr ptr `plusPtr` 12
+      pSSEC = castPtr ptr `plusPtr` 16
+      pCP = castPtr ptr `plusPtr` 20
+      pWH = castPtr ptr `plusPtr` 24
+  poke ptr (SERVICE_STATUS st cs ca ec ssec cp wh) = do
+    pokeServiceType (castPtr ptr) st
+    pokeServiceState (castPtr ptr `plusPtr` 4) cs
+    pokeServiceAccept (castPtr ptr `plusPtr` 8)  ca
+    poke (castPtr ptr `plusPtr` 12) ec
+    poke (castPtr ptr `plusPtr` 16) ssec
+    poke (castPtr ptr `plusPtr` 20) cp
+    poke (castPtr ptr `plusPtr` 24) wh
src/System/Win32/SystemServices/Services/SERVICE_TABLE_ENTRY.hs view
@@ -1,29 +1,29 @@-module System.Win32.SystemServices.Services.SERVICE_TABLE_ENTRY where--import Control.Applicative-import Foreign-import System.Win32.Types--import System.Win32.SystemServices.Services.Types--data SERVICE_TABLE_ENTRY = SERVICE_TABLE_ENTRY-    { serviceName :: LPWSTR-    , serviceProc :: FunPtr SERVICE_MAIN_FUNCTION-    }--instance Storable SERVICE_TABLE_ENTRY where-  sizeOf _ = 8-  alignment _ = 4-  peek ptr = SERVICE_TABLE_ENTRY <$> peek pServiceName <*> peek pServiceProc-    where-      pServiceName = castPtr ptr-      pServiceProc = castPtr ptr `plusPtr` 4-  poke ptr ste = do-      poke pServiceName . serviceName $ ste-      poke pServiceProc . serviceProc $ ste-    where-      pServiceName = castPtr ptr-      pServiceProc = castPtr ptr `plusPtr` 4--nullSTE :: SERVICE_TABLE_ENTRY-nullSTE = SERVICE_TABLE_ENTRY nullPtr nullFunPtr+module System.Win32.SystemServices.Services.SERVICE_TABLE_ENTRY where
+
+import Control.Applicative
+import Foreign
+import System.Win32.Types
+
+import System.Win32.SystemServices.Services.Types
+
+data SERVICE_TABLE_ENTRY = SERVICE_TABLE_ENTRY
+    { serviceName :: LPWSTR
+    , serviceProc :: FunPtr SERVICE_MAIN_FUNCTION
+    }
+
+instance Storable SERVICE_TABLE_ENTRY where
+  sizeOf _ = 8
+  alignment _ = 4
+  peek ptr = SERVICE_TABLE_ENTRY <$> peek pServiceName <*> peek pServiceProc
+    where
+      pServiceName = castPtr ptr
+      pServiceProc = castPtr ptr `plusPtr` 4
+  poke ptr ste = do
+      poke pServiceName . serviceName $ ste
+      poke pServiceProc . serviceProc $ ste
+    where
+      pServiceName = castPtr ptr
+      pServiceProc = castPtr ptr `plusPtr` 4
+
+nullSTE :: SERVICE_TABLE_ENTRY
+nullSTE = SERVICE_TABLE_ENTRY nullPtr nullFunPtr
src/System/Win32/SystemServices/Services/SERVICE_TYPE.hs view
@@ -1,55 +1,55 @@-module System.Win32.SystemServices.Services.SERVICE_TYPE-    ( SERVICE_TYPE (..)-    , peekServiceType-    , pokeServiceType-    ) where--import Foreign-import System.Win32.Types (DWORD)-import Text.Printf--import Control.Error----- | Win32 defines many types of services, but this binding only supports--- WIN32_OWN_PROCESS.-data SERVICE_TYPE-    -- | The service is a file system driver.-    = FILE_SYSTEM_DRIVER-    -- | The service is a device driver.-    | KERNEL_DRIVER-    -- | The service runs in its own process.-    | WIN32_OWN_PROCESS-    -- | The service shares a process with other services.-    | WIN32_SHARE_PROCESS-    -- | Do no write your own services of this type. Windows Vista and above-    --   prevent service processes from directly interacting with users.-    ---    --   A 'SERVICE_INTERACTIVE_PROCESS' is either a 'WIN32_OWN_PROCESS' or a-    --   'WIN32_SHARE_PROCESS' running in the context of the LocalSystem-    --   account which is allowed to directly interact with users.-    | SERVICE_INTERACTIVE_PROCESS-    deriving (Show)--toDWORD :: SERVICE_TYPE -> DWORD-toDWORD FILE_SYSTEM_DRIVER          = 0x00000002-toDWORD KERNEL_DRIVER               = 0x00000001-toDWORD WIN32_OWN_PROCESS           = 0x00000010-toDWORD WIN32_SHARE_PROCESS         = 0x00000020-toDWORD SERVICE_INTERACTIVE_PROCESS = 0x00000100--fromDWORD :: DWORD -> Either String SERVICE_TYPE-fromDWORD 0x00000002 = Right FILE_SYSTEM_DRIVER-fromDWORD 0x00000001 = Right KERNEL_DRIVER-fromDWORD 0x00000010 = Right WIN32_OWN_PROCESS-fromDWORD 0x00000020 = Right WIN32_SHARE_PROCESS-fromDWORD 0x00000100 = Right SERVICE_INTERACTIVE_PROCESS-fromDWORD x = Left $ "Invalid SERVICE_TYPE: " ++ printf "%x" x--peekServiceType :: Ptr DWORD -> Script SERVICE_TYPE-peekServiceType ptr = do-    dword <- scriptIO $ peek ptr-    hoistEither $ fromDWORD dword--pokeServiceType :: Ptr DWORD -> SERVICE_TYPE -> IO ()-pokeServiceType ptr x = poke ptr . toDWORD $ x+module System.Win32.SystemServices.Services.SERVICE_TYPE
+    ( SERVICE_TYPE (..)
+    , peekServiceType
+    , pokeServiceType
+    ) where
+
+import Foreign
+import System.Win32.Types (DWORD)
+import Text.Printf
+
+import Control.Error
+
+
+-- | Win32 defines many types of services, but this binding only supports
+-- WIN32_OWN_PROCESS.
+data SERVICE_TYPE
+    -- | The service is a file system driver.
+    = FILE_SYSTEM_DRIVER
+    -- | The service is a device driver.
+    | KERNEL_DRIVER
+    -- | The service runs in its own process.
+    | WIN32_OWN_PROCESS
+    -- | The service shares a process with other services.
+    | WIN32_SHARE_PROCESS
+    -- | Do no write your own services of this type. Windows Vista and above
+    --   prevent service processes from directly interacting with users.
+    --
+    --   A 'SERVICE_INTERACTIVE_PROCESS' is either a 'WIN32_OWN_PROCESS' or a
+    --   'WIN32_SHARE_PROCESS' running in the context of the LocalSystem
+    --   account which is allowed to directly interact with users.
+    | SERVICE_INTERACTIVE_PROCESS
+    deriving (Show)
+
+toDWORD :: SERVICE_TYPE -> DWORD
+toDWORD FILE_SYSTEM_DRIVER          = 0x00000002
+toDWORD KERNEL_DRIVER               = 0x00000001
+toDWORD WIN32_OWN_PROCESS           = 0x00000010
+toDWORD WIN32_SHARE_PROCESS         = 0x00000020
+toDWORD SERVICE_INTERACTIVE_PROCESS = 0x00000100
+
+fromDWORD :: DWORD -> Either String SERVICE_TYPE
+fromDWORD 0x00000002 = Right FILE_SYSTEM_DRIVER
+fromDWORD 0x00000001 = Right KERNEL_DRIVER
+fromDWORD 0x00000010 = Right WIN32_OWN_PROCESS
+fromDWORD 0x00000020 = Right WIN32_SHARE_PROCESS
+fromDWORD 0x00000100 = Right SERVICE_INTERACTIVE_PROCESS
+fromDWORD x = Left $ "Invalid SERVICE_TYPE: " ++ printf "%x" x
+
+peekServiceType :: Ptr DWORD -> Script SERVICE_TYPE
+peekServiceType ptr = do
+    dword <- scriptIO $ peek ptr
+    hoistEither $ fromDWORD dword
+
+pokeServiceType :: Ptr DWORD -> SERVICE_TYPE -> IO ()
+pokeServiceType ptr x = poke ptr . toDWORD $ x
src/System/Win32/SystemServices/Services/Types.hs view
@@ -1,10 +1,10 @@-module System.Win32.SystemServices.Services.Types where--import Foreign.Ptr (FunPtr, Ptr)-import System.Win32.Types--type HANDLER_FUNCTION_EX = DWORD -> DWORD -> Ptr () -> Ptr () -> IO DWORD-type LPHANDLER_FUNCTION_EX = FunPtr HANDLER_FUNCTION_EX--type SERVICE_MAIN_FUNCTION = DWORD -> Ptr LPTSTR -> IO ()-type LPSERVICE_MAIN_FUNCTION = FunPtr SERVICE_MAIN_FUNCTION+module System.Win32.SystemServices.Services.Types where
+
+import Foreign.Ptr (FunPtr, Ptr)
+import System.Win32.Types
+
+type HANDLER_FUNCTION_EX = DWORD -> DWORD -> Ptr () -> Ptr () -> IO DWORD
+type LPHANDLER_FUNCTION_EX = FunPtr HANDLER_FUNCTION_EX
+
+type SERVICE_MAIN_FUNCTION = DWORD -> Ptr LPTSTR -> IO ()
+type LPSERVICE_MAIN_FUNCTION = FunPtr SERVICE_MAIN_FUNCTION