ApplePush (empty) → 0.1

raw patch · 8 files changed

+285/−0 lines, 8 filesdep +basedep +binarydep +bytestringsetup-changed

Dependencies added: base, binary, bytestring, haskell98, json, mtl, network

Files

• ApplePush.cabal +29/−0
• LICENSE +28/−0
• Setup.hs +4/−0
• src/ApplePush.hs +69/−0
• src/ApplePush/Helpers.hs +34/−0
• src/ApplePush/Notification.hs +34/−0
• src/ApplePush/Types.hs +39/−0
• src/Main.hs +48/−0

@@ -0,0 +1,29 @@+Name:           ApplePush+Version:        0.1++Cabal-Version:  >= 1.2+Author:         Chris Moos <chris@tech9computers.com>+Maintainer:     Chris Moos <chris@tech9computers.com>+Synopsis:       Library for Apple Push Notification Service+Category:       Network+license:	BSD3+license-file:	LICENSE+Build-Type:     Simple+Description:    This library provides an interface to send notifications with the Apple Push Notification Service.+                +                .+                Note: Your connection to Apple's Push Notification service must be secured with SSL. Currently, Haskell's support+                for SSL is incomplete, therefore you should use an SSL tunnel to connect your application to the push service, such as                       stunnel.++library+    build-depends:      base >= 4 && < 5, haskell98, bytestring >= 0.9,+                        binary >= 0.5, mtl, network, json >= 0.4+    exposed-modules:    ApplePush, ApplePush.Types, ApplePush.Notification, ApplePush.Helpers+    hs-source-dirs:     src+    +Executable applepushtest+    Build-Depends:      base+    other-modules:      ApplePush+    Main-Is:            Main.hs+    ghc-options:        -threaded+    Hs-Source-Dirs:     src

@@ -0,0 +1,28 @@+Copyright (c) Chris Moos 2009++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+   notice, this list of conditions and the following disclaimer in the+   documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.+

@@ -0,0 +1,4 @@+module Main where++import Distribution.Simple+main = defaultMain

@@ -0,0 +1,69 @@+-- | 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)+	

@@ -0,0 +1,34 @@+-- | Helpers for the Apple Push Service+module ApplePush.Helpers (+hexTokenToByteString,+tokenToString,+byteStringToHex+) where	++import qualified Data.ByteString as BS+import Data.Word+import Numeric++import ApplePush.Types++byteStringToHex :: BS.ByteString -> String+byteStringToHex bs = do+	let s = concat $ map (\x -> (toHex x) ++ " ") (BS.unpack bs)+	take ((length s) - 1) s++toHex :: Word8 -> String+toHex b = case showHex b "" of+	      	a:b:[] -> a:b:[]+	      	a:[] -> '0':a:[]++-- | Converts a device token to a hex string+tokenToString :: DeviceToken -> String+tokenToString y = (concat $ map (\x -> showHex x "") (BS.unpack y))++-- | Converts a hex string to a device token+hexTokenToByteString :: String -> DeviceToken+hexTokenToByteString [] = BS.empty+hexTokenToByteString (a:[]) = BS.empty+hexTokenToByteString (a:b:r) = do+	BS.append (BS.pack [(read (concat $ ["0x", [a], [b]]) :: Word8)]) $ hexTokenToByteString r+	

@@ -0,0 +1,34 @@+-- | Creates JSON notification payloads for the Apple Push Notification Service+module ApplePush.Notification (+makeRawNotification,+makeNotification+) where+	+import Text.JSON++import ApplePush.Types+++-- | Makes a notification, takes an alert(string/dictionary), integer, string for the sound, and any user data (key/value dictionary.)+makeNotification :: Maybe (Either String [(String, JSValue)]) -> Maybe Integer -> Maybe String -> Maybe [(String, JSValue)] -> String+makeNotification alert badge sound ud = do+	encodeStrict $ makeObj $ [("aps", makeObj ((mkAlert alert) ++ (mkBadge badge) ++ (mkSound sound)))] ++ (mkUD ud)+	where+		mkSound (Just x) = [("sound", showJSON $ x)]+		mkSound Nothing = []+		mkBadge (Just x) = [("badge", showJSON $ x)]+		mkBadge Nothing = []+		mkUD (Just x) = x+		mkUD Nothing = []+		mkAlert (Just (Right x)) = mkRawAlert $ makeObj x+		mkAlert (Just (Left x)) = mkRawAlert $ showJSON x+		mkAlert Nothing = []+		mkRawAlert x = [("alert", x)]++makeNotification Nothing Nothing Nothing Nothing = makeRawNotification [("aps", showJSON $ "")]+++-- | Takes a list of key, JSValue pairs and converts them to a string+makeRawNotification :: [(String, JSValue)] -> String+makeRawNotification x = do+	encodeStrict $ makeObj x

@@ -0,0 +1,39 @@+-- | Types for the Apple Push Service+module ApplePush.Types (+DeviceToken,+NotificationServiceMsg(..),+NotificationServiceChan,+NotificationCallbackMsg(..),+NotificationCallbackChan,+NotificationPayload,+NotificationAction+) where+	+import Data.ByteString	+import Control.Concurrent.Chan+import Control.Concurrent.MVar+import Control.Concurrent+import Control.Monad.State as SM+import Text.JSON++-- | Device Token+type DeviceToken = ByteString++-- | These messages are sent to the Apple Push Notification Service+data NotificationServiceMsg = NotificationServiceSend DeviceToken String | NotificationServiceExit++type NotificationServiceChan = Chan NotificationServiceMsg+++-- | Callback messages from the Apple Push Notification Service+data NotificationCallbackMsg = NotificationServerConnected NotificationServiceChan | +	NotificationServerUnableToConnect String | NotificationServerDisconnected++type NotificationCallbackChan = Chan NotificationCallbackMsg+++-- | Notification payload is a JSON Object+type NotificationPayload = JSObject JSValue++-- | Notification actions+type NotificationAction = JSObject JSValue

@@ -0,0 +1,48 @@+module Main where++import System+import System.IO+import qualified Data.ByteString as BS+import Control.Concurrent.Chan+import Control.Concurrent+import Text.JSON++import ApplePush++appVersion = 0.1++getMsgs t c = do+	putStr "Message> "+	hFlush stdout+	m <- hGetLine stdin+	writeChan c (NotificationServiceSend t (makeNotification (Just $ Left $ m) Nothing (Just "chime") Nothing))+	getMsgs t c++notificationCallback :: DeviceToken -> NotificationCallbackChan -> IO ()+notificationCallback t c = do+	msg <- readChan c+	case msg of+		(NotificationServerConnected srvChan) -> do+			tid <- forkIO $ getMsgs t srvChan+			return ()+		_ -> return ()+	notificationCallback t c++showUsage a v = do+	putStrLn $ "Apple Push Test, Version " ++ (show v)	+	putStrLn $ "usage: " ++ a ++ " device_token(hex)"++start (device_token:a) = do+	let token = hexTokenToByteString device_token+	putStrLn $ "Device Token: " ++ (tokenToString token)+	c <- newChan+	connectToNotificationService "127.0.0.1" 2195 c+	notificationCallback token c++main :: IO ()+main = do+	args <- getArgs+	prog <- getProgName+	if length args < 1 +		then showUsage prog appVersion+		else start args