module System.Win32.Services.Control ( ServiceControl (..) , peekServiceControl , pokeServiceControl , marshIn ) where import Text.Printf import Import -- | A ServiceControl 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 'ServiceControl' to a 'DWORD'. -- Use 'convertAttempt' to translate from a 'DWORD' to a 'ServiceControl'. data ServiceControl = Continue | Interrogate | NetBindAdd | NetBindDisable | NetBindEnable | NetBindRemove | ParamChange | Pause | PreShutdown | Shutdown | Stop deriving (Show) peekServiceControl :: Ptr DWORD -> IO (Either String ServiceControl) peekServiceControl ptr = marshIn <$> peek ptr pokeServiceControl :: Ptr DWORD -> ServiceControl -> IO () pokeServiceControl ptr sc = poke ptr . marshOut $ sc -- | Marshal a ServiceAccept "out" to be used in C-land marshOut :: ServiceControl -> DWORD marshOut Continue = 0x00000003 marshOut Interrogate = 0x00000004 marshOut NetBindAdd = 0x00000007 marshOut NetBindDisable = 0x0000000A marshOut NetBindEnable = 0x00000009 marshOut NetBindRemove = 0x00000008 marshOut ParamChange = 0x00000006 marshOut Pause = 0x00000002 marshOut PreShutdown = 0x0000000F marshOut Shutdown = 0x00000005 marshOut Stop = 0x00000001 -- | Marshall a DWORD "in" to be used in Haskell-land as a ServiceAccept marshIn :: DWORD -> Either String ServiceControl marshIn 0x00000003 = Right Continue marshIn 0x00000004 = Right Interrogate marshIn 0x00000007 = Right NetBindAdd marshIn 0x0000000A = Right NetBindDisable marshIn 0x00000009 = Right NetBindEnable marshIn 0x00000008 = Right NetBindRemove marshIn 0x00000006 = Right ParamChange marshIn 0x00000002 = Right Pause marshIn 0x0000000F = Right PreShutdown marshIn 0x00000005 = Right Shutdown marshIn 0x00000001 = Right Stop marshIn 0x0000000B = unsupported "SERVICE_CONTROL_DEVICEEVENT" marshIn 0x0000000C = unsupported "SERVICE_CONTROL_HARDWAREPROFILECHANGE" marshIn 0x0000000D = unsupported "SERVICE_CONTROL_POWEREVENT" marshIn 0x0000000E = unsupported "SERVICE_CONTROL_SESSIONCHANGE" marshIn 0x00000010 = unsupported "SERVICE_CONTROL_TIMECHANGE" marshIn 0x00000020 = unsupported "SERVICE_CONTROL_TRIGGEREVENT" marshIn 0x00000040 = unsupported "SERVICE_CONTROL_USERMODEREBOOT" marshIn 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."