-- |
--   Copyright   :  (c) Sam Truzjan 2013
--   License     :  BSD3
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  experimental
--   Portability :  portable
--
--   Connects to a device event source.
--
{-# LANGUAGE OverloadedStrings #-}
module System.UDev.Monitor
       ( Monitor

         -- * Creation
       , SourceId (..)
       , newFromNetlink

         -- * Receiving
       , enableReceiving
       , setReceiveBufferSize
       , getFd
       , getHandle
       , receiveDevice

         -- * Filter
       , filterAddMatchSubsystemDevtype
       , filterAddMatchTag
       , filterUpdate
       , filterRemove
       ) where

import Control.Applicative
import Control.Monad
import Data.ByteString as BS
import Foreign
import Foreign.C.Error
import Foreign.C.String
import Foreign.C.Types
import System.Posix.Types
import System.Posix.IO
import System.IO

import System.UDev.Context
import System.UDev.Device
import System.UDev.Types

-- | Opaque object handling an event source.
newtype Monitor = Monitor { Monitor -> Ptr Monitor
getMonitor :: Ptr Monitor }


foreign import ccall unsafe "udev_monitor_get_udev"
  c_getUDev :: Monitor -> UDev

instance UDevChild Monitor where
  getUDev :: Monitor -> UDev
getUDev = Monitor -> UDev
c_getUDev

foreign import ccall unsafe "udev_monitor_ref"
  c_ref :: Monitor -> IO Monitor

foreign import ccall unsafe "udev_monitor_unref"
  c_unref :: Monitor -> IO Monitor

instance Ref Monitor where
  ref :: Monitor -> IO Monitor
ref   = Monitor -> IO Monitor
c_ref
  unref :: Monitor -> IO Monitor
unref = Monitor -> IO Monitor
c_unref

foreign import ccall unsafe "udev_monitor_new_from_netlink"
  c_newFromNetlink :: UDev -> CString -> IO Monitor

-- | Event source identifier.
data SourceId
  = -- | Events are sent out just after kernel processes them.
    --
    --  Applications should usually not connect directly to the
    -- \"kernel\" events, because the devices might not be useable at
    -- that time, before udev has configured them, and created device
    -- nodes. Use 'UDevId' instead.
    --
    KernelId
  |
    -- | Events are sent out after udev has finished its event processing,
    -- all rules have been processed, and needed device nodes are created.
    UDevId
  |
    -- | For extensibility.
    OtherId ByteString
    deriving (Int -> SourceId -> ShowS
[SourceId] -> ShowS
SourceId -> String
(Int -> SourceId -> ShowS)
-> (SourceId -> String) -> ([SourceId] -> ShowS) -> Show SourceId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SourceId] -> ShowS
$cshowList :: [SourceId] -> ShowS
show :: SourceId -> String
$cshow :: SourceId -> String
showsPrec :: Int -> SourceId -> ShowS
$cshowsPrec :: Int -> SourceId -> ShowS
Show, ReadPrec [SourceId]
ReadPrec SourceId
Int -> ReadS SourceId
ReadS [SourceId]
(Int -> ReadS SourceId)
-> ReadS [SourceId]
-> ReadPrec SourceId
-> ReadPrec [SourceId]
-> Read SourceId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SourceId]
$creadListPrec :: ReadPrec [SourceId]
readPrec :: ReadPrec SourceId
$creadPrec :: ReadPrec SourceId
readList :: ReadS [SourceId]
$creadList :: ReadS [SourceId]
readsPrec :: Int -> ReadS SourceId
$creadsPrec :: Int -> ReadS SourceId
Read, SourceId -> SourceId -> Bool
(SourceId -> SourceId -> Bool)
-> (SourceId -> SourceId -> Bool) -> Eq SourceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SourceId -> SourceId -> Bool
$c/= :: SourceId -> SourceId -> Bool
== :: SourceId -> SourceId -> Bool
$c== :: SourceId -> SourceId -> Bool
Eq, Eq SourceId
Eq SourceId
-> (SourceId -> SourceId -> Ordering)
-> (SourceId -> SourceId -> Bool)
-> (SourceId -> SourceId -> Bool)
-> (SourceId -> SourceId -> Bool)
-> (SourceId -> SourceId -> Bool)
-> (SourceId -> SourceId -> SourceId)
-> (SourceId -> SourceId -> SourceId)
-> Ord SourceId
SourceId -> SourceId -> Bool
SourceId -> SourceId -> Ordering
SourceId -> SourceId -> SourceId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SourceId -> SourceId -> SourceId
$cmin :: SourceId -> SourceId -> SourceId
max :: SourceId -> SourceId -> SourceId
$cmax :: SourceId -> SourceId -> SourceId
>= :: SourceId -> SourceId -> Bool
$c>= :: SourceId -> SourceId -> Bool
> :: SourceId -> SourceId -> Bool
$c> :: SourceId -> SourceId -> Bool
<= :: SourceId -> SourceId -> Bool
$c<= :: SourceId -> SourceId -> Bool
< :: SourceId -> SourceId -> Bool
$c< :: SourceId -> SourceId -> Bool
compare :: SourceId -> SourceId -> Ordering
$ccompare :: SourceId -> SourceId -> Ordering
$cp1Ord :: Eq SourceId
Ord)

unmarshalSourceId :: SourceId -> ByteString
unmarshalSourceId :: SourceId -> ByteString
unmarshalSourceId  SourceId
KernelId   = ByteString
"kernel"
unmarshalSourceId  SourceId
UDevId     = ByteString
"udev"
unmarshalSourceId (OtherId ByteString
i) = ByteString
i
{-# INLINE unmarshalSourceId #-}

-- | Create new udev monitor and connect to a specified event source.
newFromNetlink :: UDev -> SourceId -> IO Monitor
newFromNetlink :: UDev -> SourceId -> IO Monitor
newFromNetlink UDev
udev SourceId
sid =
  Ptr Monitor -> Monitor
Monitor (Ptr Monitor -> Monitor) -> IO (Ptr Monitor) -> IO Monitor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
    String -> IO (Ptr Monitor) -> IO (Ptr Monitor)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull String
"newFromNetlink" (IO (Ptr Monitor) -> IO (Ptr Monitor))
-> IO (Ptr Monitor) -> IO (Ptr Monitor)
forall a b. (a -> b) -> a -> b
$
      ByteString -> (CString -> IO (Ptr Monitor)) -> IO (Ptr Monitor)
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString (SourceId -> ByteString
unmarshalSourceId SourceId
sid) ((CString -> IO (Ptr Monitor)) -> IO (Ptr Monitor))
-> (CString -> IO (Ptr Monitor)) -> IO (Ptr Monitor)
forall a b. (a -> b) -> a -> b
$ \ CString
c_name ->
        Monitor -> Ptr Monitor
getMonitor (Monitor -> Ptr Monitor) -> IO Monitor -> IO (Ptr Monitor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UDev -> CString -> IO Monitor
c_newFromNetlink UDev
udev CString
c_name


foreign import ccall unsafe "udev_monitor_enable_receiving"
  c_enableReceiving :: Monitor -> IO CInt

-- | Binds the 'Monitor' socket to the event source.
enableReceiving :: Monitor -> IO ()
enableReceiving :: Monitor -> IO ()
enableReceiving Monitor
monitor =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"enableReceiving" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    Monitor -> IO CInt
c_enableReceiving Monitor
monitor

foreign import ccall unsafe "udev_monitor_set_receive_buffer_size"
  c_setReceiveBufferSize :: Monitor -> CInt -> IO CInt

-- | Set the size of the kernel socket buffer.
setReceiveBufferSize :: Monitor -> Int -> IO ()
setReceiveBufferSize :: Monitor -> Int -> IO ()
setReceiveBufferSize Monitor
monitor Int
size =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"setReceiveBufferSize" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    Monitor -> CInt -> IO CInt
c_setReceiveBufferSize Monitor
monitor (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)

foreign import ccall unsafe "udev_monitor_get_fd"
  c_getFd :: Monitor -> IO CInt

-- | Retrieve the socket file descriptor associated with the monitor.
getFd :: Monitor -> IO Fd
getFd :: Monitor -> IO Fd
getFd Monitor
monitor = CInt -> Fd
Fd (CInt -> Fd) -> IO CInt -> IO Fd
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Monitor -> IO CInt
c_getFd Monitor
monitor

-- | Similar to 'getFd' but retrieves the socket /handle/ associated
-- with the monitor.
getHandle :: Monitor -> IO Handle
getHandle :: Monitor -> IO Handle
getHandle = Monitor -> IO Fd
getFd (Monitor -> IO Fd) -> (Fd -> IO Handle) -> Monitor -> IO Handle
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Fd -> IO Handle
fdToHandle

foreign import ccall unsafe "udev_monitor_receive_device"
  c_receiveDevice :: Monitor -> IO Device

-- | Receive data from the udev monitor socket, allocate a new udev
-- device, fill in the received data, and return the device.
--
receiveDevice :: Monitor -> IO Device
receiveDevice :: Monitor -> IO Device
receiveDevice Monitor
monitor =
  Ptr Device -> Device
Device (Ptr Device -> Device) -> IO (Ptr Device) -> IO Device
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    String -> IO (Ptr Device) -> IO (Ptr Device)
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull String
"receiveDevice"
      (Device -> Ptr Device
getDevice (Device -> Ptr Device) -> IO Device -> IO (Ptr Device)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Monitor -> IO Device
c_receiveDevice Monitor
monitor)

foreign import ccall unsafe "udev_monitor_filter_add_match_subsystem_devtype"
  c_filterAddMatchSubsystemDevtype :: Monitor -> CString -> CString -> IO CInt

-- | Filter events by subsystem and device type.
--
-- The filter /must be/ installed before the monitor is switched to
-- listening mode.
--
filterAddMatchSubsystemDevtype :: Monitor -> ByteString -> Maybe ByteString -> IO ()
filterAddMatchSubsystemDevtype :: Monitor -> ByteString -> Maybe ByteString -> IO ()
filterAddMatchSubsystemDevtype Monitor
monitor ByteString
subsystem Maybe ByteString
mbDevtype =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"filterAddMatchSubsystemDevtype" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
subsystem ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ CString
c_subsystem ->
      case Maybe ByteString
mbDevtype of
        Just ByteString
devtype ->
            ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
devtype ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ CString
c_devtype   ->
              Monitor -> CString -> CString -> IO CInt
c_filterAddMatchSubsystemDevtype Monitor
monitor CString
c_subsystem CString
c_devtype
        Maybe ByteString
Nothing ->
              Monitor -> CString -> CString -> IO CInt
c_filterAddMatchSubsystemDevtype Monitor
monitor CString
c_subsystem CString
forall a. Ptr a
nullPtr

foreign import ccall unsafe "udev_monitor_filter_add_match_tag"
  c_filterAddMatchTag :: Monitor -> CString -> IO CInt

-- | The filter must be installed before the monitor is switched to
-- listening mode.
--
filterAddMatchTag :: Monitor -> ByteString -> IO ()
filterAddMatchTag :: Monitor -> ByteString -> IO ()
filterAddMatchTag Monitor
monitor ByteString
tag =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"filterAddMatchTag" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    ByteString -> (CString -> IO CInt) -> IO CInt
forall a. ByteString -> (CString -> IO a) -> IO a
useAsCString ByteString
tag ((CString -> IO CInt) -> IO CInt)
-> (CString -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \ CString
c_tag ->
      Monitor -> CString -> IO CInt
c_filterAddMatchTag Monitor
monitor CString
c_tag

foreign import ccall unsafe "udev_monitor_filter_update"
  c_filterUpdate :: Monitor -> IO CInt

-- | Update the installed socket filter. This is only needed, if the
-- filter was removed or changed.
--
filterUpdate :: Monitor -> IO ()
filterUpdate :: Monitor -> IO ()
filterUpdate Monitor
monitor =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"filterUpdate" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    Monitor -> IO CInt
c_filterUpdate Monitor
monitor


foreign import ccall unsafe "udev_monitor_filter_remove"
  c_filterRemove :: Monitor -> IO CInt

-- | Remove all filters from monitor.
filterRemove :: Monitor -> IO ()
filterRemove :: Monitor -> IO ()
filterRemove Monitor
monitor =
  String -> IO CInt -> IO ()
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"filterRemove" (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$
    Monitor -> IO CInt
c_filterRemove Monitor
monitor