-- | This module implements the Apple Push Notification Service -- -- -- The notification service uses 'Control.Concurrent.Chan' for asynchronous communication. -- Call 'connectToNotificationService' and pass it a 'NotificationCallbackChan'. -- The notification service will post a 'NotificationServerConencted' message, with a channel that you should use to send notifications with. module ApplePush ( module ApplePush.Types, module ApplePush.Helpers, module ApplePush.Notification, connectToNotificationService ) where import ApplePush.Types import ApplePush.Notification import ApplePush.Helpers import Network import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import qualified Data.ByteString.Char8 as BSC import System.IO import Data.Binary.Put import Control.Concurrent.Chan import Control.Concurrent import qualified Control.Exception(catch) handleMsg hdl (NotificationServiceSend token payload) = do let y = BS.pack $ BSL.unpack $ runPut $ do putWord8 0 {- command -} putWord16be 32 {- token -} putByteString token putWord16be (fromIntegral $ length payload) {- payload length -} putByteString $ BSC.pack payload BS.hPut hdl y hFlush hdl handleMsg hdl NotificationServiceExit = do return () handleMsg hdl msg = return () notificationServiceHandler :: Handle -> NotificationServiceChan -> NotificationCallbackChan -> IO () notificationServiceHandler hdl sc cc = do msg <- readChan sc handleMsg hdl msg notificationServiceHandler hdl sc cc onConnect :: Handle -> NotificationCallbackChan -> IO () onConnect hdl callback = do c <- newChan writeChan callback (NotificationServerConnected c) notificationServiceHandler hdl c callback `catch` (\e -> writeChan callback NotificationServerDisconnected) getConnection :: String -> Integer -> IO (Either String Handle) getConnection h p = withSocketsDo $ do hdl <- connectTo h (PortNumber $ fromIntegral p) return $ Right hdl -- | Connects to the notification service for the host and port specified. connectToNotificationService :: String -> Integer -> NotificationCallbackChan -> IO () connectToNotificationService host port callback = do tid <- forkIO f return () where f = do hdl <- getConnection host port `catch` (\e -> return $ Left $ show e) case hdl of Right handle -> onConnect handle callback Left msg -> writeChan callback (NotificationServerUnableToConnect msg)