ApplePush-0.1: src/ApplePush.hs

-- | This module implements the Apple Push Notification Service 
-- <http://developer.apple.com/iPhone/library/documentation/NetworkingInternet/Conceptual/RemoteNotificationsPG/Introduction/Introduction.html#//apple_ref/doc/uid/TP40008194-CH1-SW1>
--
-- 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)