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
putWord16be 32
putByteString token
putWord16be (fromIntegral $ length payload)
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
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)