push-notify (empty) → 0.1.0.0
raw patch · 18 files changed
+1374/−0 lines, 18 filesdep +aesondep +asyncdep +attoparsec-conduitsetup-changed
Dependencies added: aeson, async, attoparsec-conduit, base, base16-bytestring, bytestring, cereal, certificate, conduit, containers, convertible, cprng-aes, data-default, http-conduit, http-types, monad-control, mtl, network, resourcet, retry, stm, text, time, tls, tls-extra, transformers, unordered-containers, xml-conduit
Files
- LICENSE +23/−0
- Network/PushNotify/Apns.hs +27/−0
- Network/PushNotify/Apns/Constants.hs +74/−0
- Network/PushNotify/Apns/README.md +42/−0
- Network/PushNotify/Apns/Send.hs +268/−0
- Network/PushNotify/Apns/Types.hs +166/−0
- Network/PushNotify/Gcm.hs +19/−0
- Network/PushNotify/Gcm/Constants.hs +71/−0
- Network/PushNotify/Gcm/README.md +10/−0
- Network/PushNotify/Gcm/Send.hs +123/−0
- Network/PushNotify/Gcm/Types.hs +119/−0
- Network/PushNotify/Mpns.hs +24/−0
- Network/PushNotify/Mpns/Constants.hs +64/−0
- Network/PushNotify/Mpns/README.md +47/−0
- Network/PushNotify/Mpns/Send.hs +126/−0
- Network/PushNotify/Mpns/Types.hs +104/−0
- Setup.hs +2/−0
- push-notify.cabal +65/−0
+ LICENSE view
@@ -0,0 +1,23 @@+Copyright (c) 2013 Marcos Pividori++Permission is hereby granted, free of charge, to any+person obtaining a copy of this software and associated+documentation files (the "Software"), to deal in the+Software without restriction, including without limitation+the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the+Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice+shall be included in all copies or substantial portions of+the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY+KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE+WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR+PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS+OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR+OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Network/PushNotify/Apns.hs view
@@ -0,0 +1,27 @@+-- GSoC 2013 - Communicating with mobile devices.++-- | This library defines an API for communicating with iOS powered devices, sending Push Notifications through Apple Push Notification Service.++module Network.PushNotify.Apns+ ( + -- * APNS Service+ sendAPNS+ , startAPNS+ , closeAPNS+ , withAPNS+ , feedBackAPNS+ -- * APNS Settings+ , APNSConfig(..)+ , APNSManager+ , DeviceToken+ , Env(..)+ -- * APNS Messages+ , APNSmessage(..)+ , AlertDictionary(..)+ -- * APNS Results+ , APNSresult(..)+ , APNSFeedBackresult(..)+ ) where++import Network.PushNotify.Apns.Types+import Network.PushNotify.Apns.Send
+ Network/PushNotify/Apns/Constants.hs view
@@ -0,0 +1,74 @@+-- GSoC 2013 - Communicating with mobile devices.++{-# LANGUAGE OverloadedStrings #-}++-- | This Module define the main contants for sending Push Notifications through Apple Push Notification Service.++module Network.PushNotify.Apns.Constants where++import Data.Text++cLOCAL_URL :: String+cLOCAL_URL = "localhost"++cLOCAL_PORT :: Integer+cLOCAL_PORT = 2195++cLOCAL_FEEDBACK_URL :: String+cLOCAL_FEEDBACK_URL = "localhost"++cLOCAL_FEEDBACK_PORT :: Integer+cLOCAL_FEEDBACK_PORT = 2196++cDEVELOPMENT_URL :: String+cDEVELOPMENT_URL = "gateway.sandbox.push.apple.com"++cDEVELOPMENT_PORT :: Integer+cDEVELOPMENT_PORT = 2195++cDEVELOPMENT_FEEDBACK_URL :: String+cDEVELOPMENT_FEEDBACK_URL = "feedback.sandbox.push.apple.com"++cDEVELOPMENT_FEEDBACK_PORT :: Integer+cDEVELOPMENT_FEEDBACK_PORT = 2196++cPRODUCTION_URL :: String+cPRODUCTION_URL = "gateway.push.apple.com"++cPRODUCTION_PORT :: Integer+cPRODUCTION_PORT = 2195++cPRODUCTION_FEEDBACK_URL :: String+cPRODUCTION_FEEDBACK_URL = "feedback.push.apple.com"++cPRODUCTION_FEEDBACK_PORT :: Integer+cPRODUCTION_FEEDBACK_PORT = 2196++-- Fields for JSON object to be sent to APNS servers.++cAPPS :: Text+cAPPS = "aps"++cALERT :: Text+cALERT = "alert"++cBADGE :: Text+cBADGE = "badge"++cSOUND :: Text+cSOUND = "sound"++cBODY :: Text+cBODY = "body"++cACTION_LOC_KEY :: Text+cACTION_LOC_KEY = "action-loc-key"++cLOC_KEY :: Text+cLOC_KEY = "loc-key"++cLOC_ARGS :: Text+cLOC_ARGS = "loc-args"++cLAUNCH_IMAGE :: Text+cLAUNCH_IMAGE = "launch-image"
+ Network/PushNotify/Apns/README.md view
@@ -0,0 +1,42 @@+## API for communicating through APNS+I developed an API for communicating through APNS with iOS mobile devices.+For this, I designed a way of building the messages, sending them and handling the result.+One important thing that I had to take into account, was how to maintain the connection. For APNS, I needed to communicate through a streaming SSL connection, so I couldn't use conduit as I 've done with GCM. So, to face this problem, I developed an APNSManager.+The API looks like this:++ **startAPNS** :: APNSConfig -> IO APNSManager + **closeAPNS** :: APNSManager -> IO () + **sendAPNS** :: APNSManager -> APNSmessage -> IO APNSresult+ **withAPNS** :: APNSConfig -> (APNSManager -> IO a) -> IO a+ **feedBackAPNS** :: APNSConfig -> IO APNSFeedBackresult ++The main idea is:++- First of all, the sevice is started with: 'startAPNS'.+ This function:+ * Creates a channel to put the notifications to be sent.+ * Starts a worker thread, which maintains the connection with APNS servers, and sends the data it receives through the cannel.+ * Returns an APNSManager.++- Then, I can use 'sendAPNS' to send messages. Every time I call it:+ * It puts the message on the channel.+ * Wait until the time the message is taken by the worker thread.+ * When the message is taken from the channel, the worker thread will send me a duplicate copy of the error channel. So, I will wait for the end of the sending, or an error msg through the error channel.+ * I return the appropiate result depending on a successful or not operation.++- I stop the service with 'closeAPNS'. It kills the worker thread.++The worker identifies each message it sends with a number, which is sent to APNS. If an error ocurred, this number is returned in an error messages by the APNS servers, representing the number of the last message that was successfully sent.+Then, the worker continually sends messages until it receives an error message. In this case, it resends the error message to the error channel for all the threads waiting for a response, and then it restarts itself, because after an error, APNS servers close the connection.+The time we wait for an error response, after having sent all the messages, can be stablished with the timeoutLimit parameter, when creating a Manager.++As to use this service, Apple requires you to be an enrolled iOS Developer or something similar, I decided to test the API with a local server. This server was taken from: [3](http://bravenewmethod.wordpress.com/2013/04/20/test-server-for-apple-push-notification-and-feedback-integration/) . It simulates the APNS servers and I modified it to test different common scenes.++The code is available on GitHub:+ - The APNS Api : [1](https://github.com/MarcosPividori/GSoC-Communicating-with-mobile-devices/tree/master/push-notify/Network/PushNotify/Apns)+ - Test example for APNS: [2](https://github.com/MarcosPividori/GSoC-Communicating-with-mobile-devices/tree/master/push-notify/test/testAPNS)++For more information about:+ - The APNS Service: [4](http://developer.apple.com/library/ios/#documentation/NetworkingInternet/Conceptual/RemoteNotificationsPG/Chapters/ApplePushService.html#//apple_ref/doc/uid/TP40008194-CH100-SW9)+ - The communication between providers and APNS servers: [5](http://developer.apple.com/library/ios/#documentation/NetworkingInternet/Conceptual/RemoteNotificationsPG/Chapters/CommunicatingWIthAPS.html#//apple_ref/doc/uid/TP40008194-CH101-SW1)+ - This project, you can go to the blog: [6](http://gsoc2013cwithmobiledevices.blogspot.com.ar/)
+ Network/PushNotify/Apns/Send.hs view
@@ -0,0 +1,268 @@+-- GSoC 2013 - Communicating with mobile devices.++{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}++-- | This Module define the main functions to send Push Notifications through Apple Push Notification Service,+-- and to communicate to the Feedback Service.+module Network.PushNotify.Apns.Send+ ( sendAPNS+ , startAPNS+ , closeAPNS+ , withAPNS+ , feedBackAPNS+ ) where++import Network.PushNotify.Apns.Types+import Network.PushNotify.Apns.Constants++import Control.Concurrent+import Control.Concurrent.Async+import Control.Concurrent.STM.TChan+import Control.Monad.STM+import Control.Retry+import Data.Certificate.X509 (X509)+import Data.Convertible (convert)+import Data.Default+import Data.Int+import Data.IORef+import Data.Serialize+import Data.Text.Encoding (encodeUtf8,decodeUtf8)+import Data.Time.Clock+import Data.Time.Clock.POSIX+import qualified Data.Aeson.Encode as AE+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Base16 as B16+import qualified Data.HashSet as HS+import qualified Data.HashMap.Strict as HM+import qualified Control.Exception as CE+import qualified Crypto.Random.AESCtr as RNG+import Network+import Network.Socket.Internal (PortNumber(PortNum))+import Network.TLS+import Network.TLS.Extra (ciphersuite_all)+import System.Timeout++connParams :: X509 -> PrivateKey -> Params+connParams cert privateKey = defaultParamsClient{+ pConnectVersion = TLS11+ , pAllowedVersions = [TLS10,TLS11,TLS12]+ , pCiphers = ciphersuite_all+ , pCertificates = [(cert , Just privateKey)]+ , onCertificatesRecv = const $ return CertificateUsageAccept+ , roleParams = Client $ ClientParams{+ clientWantSessionResume = Nothing+ , clientUseMaxFragmentLength = Nothing+ , clientUseServerName = Nothing+ , onCertificateRequest = \x -> return [(cert , Just privateKey)]+ }+ }++-- 'connectAPNS' starts a secure connection with APNS servers.+connectAPNS :: APNSConfig -> IO Context+connectAPNS config = do+ handle <- case environment config of+ Development -> connectTo cDEVELOPMENT_URL+ $ PortNumber $ fromInteger cDEVELOPMENT_PORT+ Production -> connectTo cPRODUCTION_URL+ $ PortNumber $ fromInteger cPRODUCTION_PORT+ Local -> connectTo cLOCAL_URL+ $ PortNumber $ fromInteger cLOCAL_PORT+ rng <- RNG.makeSystem+ ctx <- contextNewOnHandle handle (connParams (apnsCertificate config) (apnsPrivateKey config)) rng+ handshake ctx+ return ctx++-- | 'startAPNS' starts the APNS service.+startAPNS :: APNSConfig -> IO APNSManager+startAPNS config = do+ c <- newTChanIO+ ref <- newIORef $ Just ()+ tID <- forkIO $ CE.catch (apnsWorker config c) (\(e :: CE.SomeException) ->+ atomicModifyIORef ref (\_ -> (Nothing,())))+ return $ APNSManager ref c tID $ timeoutLimit config++-- | 'closeAPNS' stops the APNS service.+closeAPNS :: APNSManager -> IO ()+closeAPNS m = do+ atomicModifyIORef (mState m) (\_ -> (Nothing,()))+ killThread $ mWorkerID m++-- | 'sendAPNS' sends the message to a APNS Server.+sendAPNS :: APNSManager -> APNSmessage -> IO APNSresult+sendAPNS m msg = do+ s <- readIORef $ mState m+ case s of+ Nothing -> fail "APNS Service closed."+ Just () -> do+ let requestChan = mApnsChannel m+ var1 <- newEmptyMVar++ atomically $ writeTChan requestChan (var1,msg)+ Just (errorChan,startNum) <- takeMVar var1 -- waits until the request is attended by the worker thread.+ -- errorChan -> is the channel where I will receive an error message if the sending fails.+ -- startNum -> My messages will be identified from startNum to (startNum + num of messages-1)+ + v <- race (readChan errorChan) (takeMVar var1 >> (threadDelay $ mTimeoutLimit m))++ let (success,fail) = case v of+ Left s -> if s >= startNum -- an error response, s identifies the last notification that was successfully sent.+ then (\(a,b) -> (HS.fromList a,HS.fromList b)) $+ splitAt (s+1-startNum) $ HS.toList $ deviceTokens msg -- An error occurred.+ else (HS.empty,deviceTokens msg) -- An old error occurred, so nothing was sent.+ Right _ -> (deviceTokens msg,HS.empty) -- Successful.+ return $ APNSresult success fail++-- 'apnsWorker' starts the main worker thread.+apnsWorker :: APNSConfig -> TChan (MVar (Maybe (Chan Int,Int)) , APNSmessage) -> IO ()+apnsWorker config requestChan = do+ ctx <- recoverAll (apnsRetrySettings config) $ connectAPNS config -- retry to connect to APNS server+ errorChan <- newChan -- new Error Channel.+ lock <- newMVar ()+ + s <- async (catch $ sender 1 lock requestChan errorChan ctx)+ r <- async (catch $ receiver ctx)+ res <- waitEither s r++ case res of+ Left _ -> do+ cancel r+ writeChan errorChan 0+ Right v -> do+ takeMVar lock+ cancel s+ writeChan errorChan v -- v is an int representing: + -- 0 -> internal worker error.+ -- n -> the identifier received in an error msg.+ -- This represent the last message that was successfully sent.+ CE.catch (contextClose ctx) (\(e :: CE.SomeException) -> return ())+ apnsWorker config requestChan -- restarts.++ where+ catch :: IO Int -> IO Int+ catch m = CE.catch m (\(e :: CE.SomeException) -> return 0)++ sender :: Int32+ -> MVar ()+ -> TChan (MVar (Maybe (Chan Int,Int)) , APNSmessage)+ -> Chan Int+ -> Context+ -> IO Int+ sender n lock requestChan errorChan c = do -- this function reads the channel and sends the messages.++ atomically $ peekTChan requestChan+ -- Now there is at least one element in the channel, so the next readTChan won't block.+ takeMVar lock++ (var,msg) <- atomically $ readTChan requestChan++ let list = HS.toList $ deviceTokens msg+ len = convert $ HS.size $ deviceTokens msg -- len is the number of messages it will send.+ num = if (n + len :: Int32) < 0 then 1 else n -- to avoid overflow.+ echan <- dupChan errorChan+ putMVar var $ Just (echan,convert num) -- Here, notifies that it is attending this request,+ -- and provides a duplicated error channel.+ putMVar lock ()++ ctime <- getPOSIXTime+ loop var c num (createPut msg ctime) list -- sends the messages.+ sender (num+len) lock requestChan errorChan c++ receiver :: Context -> IO Int+ receiver c = do+ dat <- recvData c+ case runGet (getWord16be >> getWord32be) dat of -- COMMAND and STATUS | ID |+ Right ident -> return (convert ident)+ Left _ -> return 0++ loop :: MVar (Maybe (Chan Int,Int)) + -> Context + -> Int32 -- This number is the identifier of this message, so if the sending fails,+ -- I will receive this identifier in an error message.+ -> (DeviceToken -> Int32 -> Put)+ -> [DeviceToken]+ -> IO Bool+ loop var _ _ _ [] = tryPutMVar var Nothing+ loop var ctx num cput (x:xs) = do+ sendData ctx $ LB.fromChunks [ (runPut $ cput x num) ]+ loop var ctx (num+1) cput xs+++-- 'createPut' builds the binary block to be sent.+createPut :: APNSmessage -> NominalDiffTime -> DeviceToken -> Int32 -> Put+createPut msg ctime dst identifier = do+ let+ -- We convert the text to binary, and then decode the hexadecimal representation.+ btoken = fst $ B16.decode $ encodeUtf8 dst + bpayload = AE.encode msg+ expiryTime = case expiry msg of+ Nothing -> round (ctime + posixDayLength) -- One day for default.+ Just t -> round (utcTimeToPOSIXSeconds t)+ if (LB.length bpayload > 256)+ then fail "Too long payload"+ else do -- COMMAND|ID|EXPIRY|TOKENLEN|TOKEN|PAYLOADLEN|PAYLOAD|+ putWord8 1+ putWord32be $ convert identifier+ putWord32be expiryTime+ putWord16be $ convert $ B.length btoken+ putByteString btoken+ putWord16be $ convert $ LB.length bpayload+ putLazyByteString bpayload++-- | 'withAPNS' creates a new manager, uses it in the provided function, and then releases it.+withAPNS :: APNSConfig -> (APNSManager -> IO a) -> IO a+withAPNS confg fun = CE.bracket (startAPNS confg) closeAPNS fun++-- 'connectFeedBackAPNS' starts a secure connection with Feedback service.+connectFeedBackAPNS :: APNSConfig -> IO Context+connectFeedBackAPNS config = do+ handle <- case environment config of+ Development -> connectTo cDEVELOPMENT_FEEDBACK_URL+ $ PortNumber $ fromInteger cDEVELOPMENT_FEEDBACK_PORT+ Production -> connectTo cPRODUCTION_FEEDBACK_URL+ $ PortNumber $ fromInteger cPRODUCTION_FEEDBACK_PORT+ Local -> connectTo cLOCAL_FEEDBACK_URL+ $ PortNumber $ fromInteger cLOCAL_FEEDBACK_PORT+ rng <- RNG.makeSystem+ ctx <- contextNewOnHandle handle (connParams (apnsCertificate config) (apnsPrivateKey config)) rng+ handshake ctx+ return ctx++-- | 'feedBackAPNS' connects to the Feedback service.+feedBackAPNS :: APNSConfig -> IO APNSFeedBackresult+feedBackAPNS config = do+ ctx <- connectFeedBackAPNS config+ var <- newEmptyMVar++ tID <- forkIO $ loopReceive var ctx -- To receive.++ res <- waitAndCheck var HM.empty+ killThread tID+ bye ctx+ contextClose ctx+ return res++ where+ getData :: Get (DeviceToken,UTCTime)+ getData = do -- TIMESTAMP|TOKENLEN|TOKEN|+ time <- getWord32be+ length <- getWord16be+ dtoken <- getBytes $ convert length+ return ( decodeUtf8 $ B16.encode dtoken+ , posixSecondsToUTCTime $ fromInteger $ convert time )++ loopReceive :: MVar (DeviceToken,UTCTime) -> Context -> IO ()+ loopReceive var ctx = do+ dat <- recvData ctx+ case runGet getData dat of+ Right tuple -> do+ putMVar var tuple+ loopReceive var ctx+ Left _ -> return ()++ waitAndCheck :: MVar (DeviceToken,UTCTime) -> HM.HashMap DeviceToken UTCTime -> IO APNSFeedBackresult+ waitAndCheck var hmap = do+ v <- timeout (timeoutLimit config) $ takeMVar var+ case v of+ Nothing -> return $ APNSFeedBackresult hmap+ Just (d,t) -> waitAndCheck var (HM.insert d t hmap)
+ Network/PushNotify/Apns/Types.hs view
@@ -0,0 +1,166 @@+-- GSoC 2013 - Communicating with mobile devices.++{-# LANGUAGE FlexibleContexts #-}++-- | This Module define the main data types for sending Push Notifications through Apple Push Notification Service.++module Network.PushNotify.Apns.Types+ ( -- * APNS Settings+ APNSConfig(..)+ , APNSManager(..)+ , DeviceToken+ , Env(..)+ -- * APNS Messages+ , APNSmessage(..)+ , AlertDictionary(..)+ -- * APNS Results+ , APNSresult(..)+ , APNSFeedBackresult(..)+ ) where++import Network.PushNotify.Apns.Constants+import Network.TLS (PrivateKey)+import Control.Concurrent+import Control.Concurrent.STM.TChan+import Control.Monad.Writer+import Control.Retry+import Data.Aeson.Types+import Data.Certificate.X509 (X509)+import Data.Default+import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HS+import Data.IORef+import Data.Text+import Data.Time.Clock++-- | 'Env' represents the three possible working environments. This determines the url and port to connect to.+data Env = Development -- ^ Development environment (by Apple).+ | Production -- ^ Production environment (by Apple).+ | Local -- ^ Local environment, just to test the service in the \"localhost\".+ deriving Show++-- | 'APNSConfig' represents the main necessary information for sending notifications through APNS.+--+-- For loading the certificate and privateKey you can use: 'Network.TLS.Extra.fileReadCertificate' and 'Network.TLS.Extra.fileReadPrivateKey' .+data APNSConfig = APNSConfig+ { apnsCertificate :: X509 -- ^ Certificate provided by Apple.+ , apnsPrivateKey :: PrivateKey -- ^ Private key provided by Apple.+ , environment :: Env -- ^ One of the possible environments.+ , timeoutLimit :: Int -- ^ The time to wait for a server response. (microseconds)+ , apnsRetrySettings :: RetrySettings -- ^ How to retry to connect to APNS servers.+ }++instance Default APNSConfig where+ def = APNSConfig {+ apnsCertificate = undefined+ , apnsPrivateKey = undefined+ , environment = Development+ , timeoutLimit = 200000+ , apnsRetrySettings = RetrySettings {+ backoff = True+ , baseDelay = 200+ , numRetries = limitedRetries 5+ }+ }++data APNSManager = APNSManager+ { mState :: IORef (Maybe ())+ , mApnsChannel :: TChan ( MVar (Maybe (Chan Int,Int)) , APNSmessage)+ , mWorkerID :: ThreadId+ , mTimeoutLimit :: Int+ }++-- | Binary token stored in hexadecimal representation as text.+type DeviceToken = Text+++-- | 'APNSmessage' represents a message to be sent through APNS.+data APNSmessage = APNSmessage+ { deviceTokens :: HS.HashSet DeviceToken -- ^ Destination.+ , expiry :: Maybe UTCTime -- ^ Identifies when the notification is no longer valid and can be discarded. + , alert :: Either Text AlertDictionary -- ^ For the system to displays a standard alert.+ , badge :: Maybe Int -- ^ Number to display as the badge of the application icon.+ , sound :: Text -- ^ The name of a sound file in the application bundle.+ , rest :: Maybe Object -- ^ Extra information.+ } deriving Show++instance Default APNSmessage where+ def = APNSmessage {+ deviceTokens = HS.empty+ , expiry = Nothing+ , alert = Left empty+ , badge = Nothing+ , sound = empty+ , rest = Nothing+ }++-- | 'AlertDictionary' represents the possible dictionary in the 'alert' label.+data AlertDictionary = AlertDictionary+ { body :: Text+ , action_loc_key :: Text+ , loc_key :: Text+ , loc_args :: [Text]+ , launch_image :: Text+ } deriving Show++instance Default AlertDictionary where+ def = AlertDictionary{+ body = empty+ , action_loc_key = empty+ , loc_key = empty+ , loc_args = []+ , launch_image = empty+ }++-- | 'APNSresult' represents information about messages after a communication with APNS Servers.+data APNSresult = APNSresult+ { successfulTokens :: HS.HashSet DeviceToken+ , toReSendTokens :: HS.HashSet DeviceToken -- ^ Failed tokens that you need to resend the message to,+ -- because there was a problem.+ } deriving Show++instance Default APNSresult where+ def = APNSresult HS.empty HS.empty++-- | 'APNSFeedBackresult' represents information after connecting with the Feedback service.+data APNSFeedBackresult = APNSFeedBackresult+ { unRegisteredTokens :: HM.HashMap DeviceToken UTCTime -- ^ Devices tokens and time indicating when APNS determined+ -- that the application no longer exists on the device.+ } deriving Show++instance Default APNSFeedBackresult where+ def = APNSFeedBackresult HM.empty+++ifNotDef :: (ToJSON a,MonadWriter [Pair] m,Eq a,Default b)+ => Text+ -> (b -> a)+ -> b+ -> m ()+ifNotDef label f msg = if f def /= f msg+ then tell [(label .= (f msg))]+ else tell []++instance ToJSON APNSmessage where+ toJSON msg = case rest msg of+ Nothing -> object [(cAPPS .= toJSONapps msg)]+ Just (map) -> Object $ HM.insert cAPPS (toJSONapps msg) map++toJSONapps msg = object $ execWriter $ do+ case alert msg of+ Left xs -> if xs == empty+ then tell []+ else tell [(cALERT .= xs)]+ Right m -> tell [(cALERT .= (toJSON m))]+ ifNotDef cBADGE badge msg+ ifNotDef cSOUND sound msg++instance ToJSON AlertDictionary where+ toJSON msg = object $ execWriter $ do+ ifNotDef cBODY body msg+ ifNotDef cACTION_LOC_KEY action_loc_key msg+ ifNotDef cLOC_KEY loc_key msg+ if loc_key def /= loc_key msg+ then ifNotDef cLOC_ARGS loc_args msg+ else tell []+ ifNotDef cLAUNCH_IMAGE launch_image msg
+ Network/PushNotify/Gcm.hs view
@@ -0,0 +1,19 @@+-- GSoC 2013 - Communicating with mobile devices.++-- | This library defines an API for communicating with Android powered devices, sending Push Notifications through Google Cloud Messaging (HTTP connection).++module Network.PushNotify.Gcm+ (+ -- * GCM Service+ sendGCM+ -- * GCM Settings+ , GCMHttpConfig(..)+ , RegId+ -- * GCM Messages+ , GCMmessage(..)+ -- * GCM Result+ , GCMresult(..)+ ) where++import Network.PushNotify.Gcm.Types+import Network.PushNotify.Gcm.Send
+ Network/PushNotify/Gcm/Constants.hs view
@@ -0,0 +1,71 @@+-- GSoC 2013 - Communicating with mobile devices.++{-# LANGUAGE OverloadedStrings #-}++-- | This Module define the main contants for sending Push Notifications through Google Cloud Messaging.+module Network.PushNotify.Gcm.Constants where++import Data.Text++cPOST_URL :: Text+cPOST_URL = "https://android.googleapis.com/gcm/send"++-- Fields for JSON object in requests to GCM servers.++cREGISTRATION_IDS :: Text+cREGISTRATION_IDS = "registration_ids"++cCOLLAPSE_KEY :: Text+cCOLLAPSE_KEY = "collapse_key"++cDATA :: Text+cDATA = "data"++cDELAY_WHILE_IDLE :: Text+cDELAY_WHILE_IDLE = "delay_while_idle"++cTIME_TO_LIVE :: Text+cTIME_TO_LIVE = "time_to_live"++cRESTRICTED_PACKAGE_NAME :: Text+cRESTRICTED_PACKAGE_NAME = "restricted_package_name"++cDRY_RUN :: Text+cDRY_RUN = "dry_run"++-- Fields for a JSON response to a sucessful request.++cMULTICAST_ID :: Text+cMULTICAST_ID = "multicast_id"++cSUCESS :: Text+cSUCESS = "success"++cFAILURE :: Text+cFAILURE = "failure"++cCANONICAL_IDS :: Text+cCANONICAL_IDS = "canonical_ids"++cRESULTS :: Text+cRESULTS = "results"++cMESSAGE_ID :: Text+cMESSAGE_ID = "message_id"++cREGISTRATION_ID :: Text+cREGISTRATION_ID = "registration_id"++cERROR :: Text+cERROR = "error"++cNOT_REGISTERED :: Text+cNOT_REGISTERED = "NotRegistered"++cUNAVAILABLE :: Text+cUNAVAILABLE = "Unavailable"++-- More constants++cRETRY_AFTER :: Text+cRETRY_AFTER = "Retry-After"
+ Network/PushNotify/Gcm/README.md view
@@ -0,0 +1,10 @@+## API for communicating through GCM++This is an API for communicating through GCM with Android powered devices. I developed a way of building the messages, sending them and handling the result.+To build the messages, I developed a data type: GCMmessage, where you can customize some parameters for the servers providing the GCM service.+To send the messages you need to establish some server configurations through the data type GCMHttpConfig (as the correct Api key provided by Google). Passing this configuration, a GCMmessage and a number of retries as arguments to the function sendGCM, the notifications will be sent to the GCM Servers.+The result is shown in a new data type: GCMresult, which provides some useful information, as selecting the devices that have changed their regIds, or have been unregistered, and so on. The programmer can take his own desitions on how to handle this result in his server.++To show a simple usage of this API for GCM (Network.PushNotify.Gcm) there is a simple test example, available on: [1](https://github.com/MarcosPividori/GSoC-Communicating-with-mobile-devices/tree/master/push-notify/test)++Also there is an Android app and Yesod example available on: [2](https://github.com/MarcosPividori/GSoC-Communicating-with-mobile-devices/tree/master/test)
+ Network/PushNotify/Gcm/Send.hs view
@@ -0,0 +1,123 @@+-- GSoC 2013 - Communicating with mobile devices.++{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}++-- | This Module define the main function to send Push Notifications through Google Cloud Messaging (HTTP connection).+module Network.PushNotify.Gcm.Send (sendGCM) where++import Network.PushNotify.Gcm.Constants+import Network.PushNotify.Gcm.Types++import Data.Aeson+import Data.Aeson.Parser (json)+import Data.Aeson.Types+import Data.Conduit (($$+-))+import Data.Conduit.Attoparsec (sinkParser)+import Data.Map (Map,lookup)+import Data.String+import Data.Text (Text, pack, unpack, empty)+import qualified Data.ByteString.Char8 as B+import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HS+import Control.Concurrent+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Resource (MonadResource,runResourceT)+import Control.Retry+import Network.HTTP.Types+import Network.HTTP.Conduit++retrySettingsGCM = RetrySettings {+ backoff = True+, baseDelay = 100+, numRetries = limitedRetries 1+}++-- | 'sendGCM' sends the message to a GCM Server.+sendGCM :: Manager -> GCMHttpConfig -> GCMmessage -> IO GCMresult+sendGCM manager cnfg msg = runResourceT $ do+ req' <- liftIO $ parseUrl $ unpack cPOST_URL+ let value = toJSON msg+ valueBS = encode value+ req = req' {+ method = "POST"+ , requestBody = RequestBodyLBS valueBS+ , requestHeaders = [+ ("Content-Type", "application/json")+ , ("Authorization", fromString $ "key=" ++ (unpack $ apiKey cnfg) ) -- API Key. (provided by Google)+ ]+ }+ retry req manager (numRet cnfg) msg++-- 'retry' try numRet attemps to send the messages.+retry :: (MonadBaseControl IO m,MonadResource m)+ => Request m -> Manager -> Int -> GCMmessage -> m GCMresult+retry req manager numret msg = do+ response <- retrying (retrySettingsGCM{numRetries = limitedRetries numret})+ ifRetry $ http req manager+ if (statusCode $ responseStatus response) >= 500+ then+ case Prelude.lookup (fromString $ unpack cRETRY_AFTER) (responseHeaders response) of+ Nothing -> return $ def { success = Just 0+ , failure = Just $ HS.size $ registration_ids msg+ , errorToReSend = registration_ids msg+ } -- Persistent server internal error after retrying+ Just t -> do+ let time = (read (B.unpack t)) :: Int+ liftIO $ threadDelay (time*1000000) -- from seconds to microseconds+ retry req manager (numret-1) msg+ else+ do+ resValue <- responseBody response $$+- sinkParser json+ liftIO $ handleSucessfulResponse resValue msg++ where ifRetry x = if (statusCode $ responseStatus x) >= 500+ then case Prelude.lookup (fromString $ unpack cRETRY_AFTER) (responseHeaders x) of+ Nothing -> True -- Internal Server error, and don't specify time to wait+ Just t -> False -- Internal Server error, and specify time to wait+ else False++getValue :: FromJSON b => Text -> Map Text Value -> Maybe b+getValue x xs = do+ dat <- Data.Map.lookup x xs+ parseMaybe parseJSON dat++-- 'handleSucessfullResponse' analyzes the server response and generates useful information.+handleSucessfulResponse :: Value -> GCMmessage -> IO GCMresult+handleSucessfulResponse resValue msg =+ case (parseMaybe parseJSON resValue) :: Maybe (Map Text Value) of+ Nothing -> fail "Error parsing Response"+ Just a -> let list = case (getValue cRESULTS a) :: Maybe [(Map Text Value)] of+ Just xs -> xs+ Nothing -> []+ mapMsg= HM.fromList $ zip (HS.toList $ registration_ids msg) list+ in+ return $ def {+ multicast_id = getValue cMULTICAST_ID a+ , success = getValue cSUCESS a+ , failure = getValue cFAILURE a+ , canonical_ids = getValue cCANONICAL_IDS a++ , newRegids = let g list' = case (getValue cREGISTRATION_ID list') :: Maybe RegId of+ Just xs -> xs+ Nothing -> empty+ in HM.filter ((/=) empty) $ HM.map g mapMsg++ , messagesIds = let g list' = case (getValue cMESSAGE_ID list') :: Maybe Text of+ Just xs -> xs+ Nothing -> empty+ in HM.filter ((/=) empty) $ HM.map g mapMsg++ , errorUnRegistered = let g list' = ((getValue cERROR list') :: Maybe Text) == Just cNOT_REGISTERED+ in HS.fromList $ HM.keys $ HM.filter g mapMsg++ , errorToReSend = let g list' = ((getValue cERROR list') :: Maybe Text) == Just cUNAVAILABLE+ in HS.fromList $ HM.keys $ HM.filter g mapMsg++ , errorRest = let g list' = case (getValue cERROR list') :: Maybe Text of+ Just xs -> if xs /= cUNAVAILABLE && xs /= cNOT_REGISTERED+ then xs+ else empty+ Nothing -> empty+ in HM.filter ((/=) empty) $ HM.map g mapMsg+ }
+ Network/PushNotify/Gcm/Types.hs view
@@ -0,0 +1,119 @@+-- GSoC 2013 - Communicating with mobile devices.++{-# LANGUAGE FlexibleContexts , OverloadedStrings #-}++-- | This Module define the main data types for sending Push Notifications through Google Cloud Messaging.+module Network.PushNotify.Gcm.Types+ ( -- * GCM Settings+ GCMHttpConfig(..)+ , RegId+ -- * GCM Messages+ , GCMmessage(..)+ -- * GCM Result+ , GCMresult(..)+ ) where+++import Network.PushNotify.Gcm.Constants+import Control.Monad.Writer+import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HS+import Data.Aeson.Types+import Data.Default+import Data.Monoid+import Data.Text+++-- | 'GCMHttpConfig' represents the main necessary information for sending notifications through GCM.+data GCMHttpConfig = GCMHttpConfig+ { apiKey :: Text -- ^ Api key provided by Google.+ , numRet :: Int -- ^ Number of attemps to send the message to the server.+ } deriving Show+ +instance Default GCMHttpConfig where+ def = GCMHttpConfig "" 5++-- | 'RegId' is an unique identifier of an app/device, provided by GCM.+type RegId = Text++-- | 'GCMmessage' represents a message to be sent through GCM. In general cases, you can use the 'Default' value and only specify 'registration_ids' and 'data_object'.+--+--On the other hand, if you want to use the rest of specific aspects, you can find more information on GCM website.+data GCMmessage = GCMmessage+ { registration_ids :: HS.HashSet RegId -- ^ Destination.+ , collapse_key :: Maybe Text+ , data_object :: Maybe Object -- ^ Main JSON data to be sent.+ , delay_while_idle :: Bool+ , time_to_live :: Maybe Int+ , restricted_package_name :: Maybe Text+ , dry_run :: Bool+ } deriving Show++instance Default GCMmessage where+ def = GCMmessage {+ registration_ids = HS.empty+ , collapse_key = Nothing+ , data_object = Nothing+ , delay_while_idle = False+ , time_to_live = Nothing+ , restricted_package_name = Nothing+ , dry_run = False+ }+++-- | 'GCMresult' represents information about messages after a communication with GCM Servers.+data GCMresult = GCMresult+ { multicast_id :: Maybe Integer -- ^ Unique ID (number) identifying the multicast message.+ , success :: Maybe Int -- ^ Number of messages that were processed without an error.+ , failure :: Maybe Int -- ^ Number of messages that could not be processed.+ , canonical_ids :: Maybe Int -- ^ Number of results that contain a canonical registration ID.+ , newRegids :: HM.HashMap RegId RegId -- ^ RegIds that need to be replaced.+ , messagesIds :: HM.HashMap RegId Text -- ^ Successful RegIds, and its \"message_id\".+ , errorUnRegistered :: HS.HashSet RegId -- ^ Failed regIds that need to be removed.+ , errorToReSend :: HS.HashSet RegId -- ^ Failed regIds that is necessary to resend the message to,+ -- because there was an internal problem in GCM servers.+ , errorRest :: HM.HashMap RegId Text -- ^ Failed regIds with the rest of the possible errors+ -- (probably non-recoverable errors).+ } deriving Show++instance Default GCMresult where+ def = GCMresult {+ multicast_id = Nothing+ , success = Nothing+ , failure = Nothing+ , canonical_ids = Nothing+ , newRegids = HM.empty+ , messagesIds = HM.empty+ , errorUnRegistered = HS.empty+ , errorToReSend = HS.empty+ , errorRest = HM.empty+ }++instance Monoid GCMresult where+ mempty = def+ mappend (GCMresult _ x1 y1 z1 a1 b1 c1 d1 e1) (GCMresult _ x2 y2 z2 a2 b2 c2 d2 e2) =+ GCMresult Nothing (add x1 x2) (add y1 y2) (add z1 z2) (HM.union a1 a2) + (HM.union b1 b2) (HS.union c1 c2) (HS.union d1 d2) (HM.union e1 e2)+ where+ add x Nothing = x+ add (Just n) (Just m) = Just (n+m)+ add (Nothing) (Just m) = Just m++ifNotDef :: (ToJSON a,MonadWriter [Pair] m,Eq a)+ => Text+ -> (GCMmessage -> a)+ -> GCMmessage+ -> m ()+ifNotDef label f msg = if f def /= f msg+ then tell [(label .= (f msg))]+ else tell []++instance ToJSON GCMmessage where+ toJSON msg = object $ execWriter $ do+ ifNotDef cREGISTRATION_IDS (HS.toList . registration_ids) msg+ ifNotDef cTIME_TO_LIVE time_to_live msg+ ifNotDef cDATA data_object msg+ ifNotDef cCOLLAPSE_KEY collapse_key msg+ ifNotDef cRESTRICTED_PACKAGE_NAME restricted_package_name msg+ ifNotDef cDELAY_WHILE_IDLE delay_while_idle msg+ ifNotDef cDRY_RUN dry_run msg
+ Network/PushNotify/Mpns.hs view
@@ -0,0 +1,24 @@+-- GSoC 2013 - Communicating with mobile devices.++-- | This library defines an API for communicating with WPhone powered devices, sending Push Notifications through Microsoft Push Notification Service.++module Network.PushNotify.Mpns+ ( -- * MPNS Service+ sendMPNS+ -- * MPNS Settings+ , MPNSConfig(..)+ , DeviceURI+ -- * MPNS Messages+ , MPNSType(..)+ , MPNSInterval(..)+ , MPNSmessage(..)+ -- * MPNS Result+ , MPNSresult(..)+ , MPNSinfo(..)+ , MPNSnotifStatus(..)+ , MPNSsubStatus(..)+ , MPNSconStatus(..)+ ) where++import Network.PushNotify.Mpns.Send+import Network.PushNotify.Mpns.Types
+ Network/PushNotify/Mpns/Constants.hs view
@@ -0,0 +1,64 @@+-- GSoC 2013 - Communicating with mobile devices.++{-# LANGUAGE OverloadedStrings #-}++-- | This Module define the main contants for sending Push Notifications through Microsoft Push Notification Service.+module Network.PushNotify.Mpns.Constants where++import Network.HTTP.Types+import Data.ByteString+import Data.Text++cWindowsPhoneTarget :: HeaderName+cWindowsPhoneTarget = "X-WindowsPhone-Target"++cNotificationClass :: HeaderName+cNotificationClass = "X-NotificationClass"++cToken :: ByteString+cToken = "token"++cToast :: ByteString+cToast = "toast"++-- Fields for a Header response to a successful request.++cNotificationStatus :: HeaderName+cNotificationStatus = "X-NotificationStatus"++cSubscriptionStatus :: HeaderName+cSubscriptionStatus = "X-SubscriptionStatus"++cDeviceConnectionStatus :: HeaderName+cDeviceConnectionStatus = "X-DeviceConnectionStatus"++cNotifReceived :: Text+cNotifReceived = "Received"++cNotifDropped :: Text+cNotifDropped = "Dropped"++cNotifQueuefull :: Text+cNotifQueuefull ="QueueFull"++cNotifSuppressed :: Text+cNotifSuppressed = "Suppressed"++cSubActive :: Text+cSubActive = "Active"++cSubExpired :: Text+cSubExpired = "Expired"++cConnConnected :: Text+cConnConnected = "Connected"++cConnInactive :: Text+cConnInactive = "InActive"++cConnDisconnected :: Text+cConnDisconnected = "Disconnected"++cConnTempDisconn :: Text+cConnTempDisconn = "TempDisconnected"+
+ Network/PushNotify/Mpns/README.md view
@@ -0,0 +1,47 @@+## API for communicating through MPNS++I developed an API for communicating through MPNS with Windows Phone mobile devices ([1](https://github.com/MarcosPividori/GSoC-Communicating-with-mobile-devices/tree/master/push-notify/Network/PushNotify/Mpns)). For this, I designed a way of building the messages, sending them and handling the result.++To communicate with MPNS servers, I need to send POST requests, so I decided to use Conduit, as I have done with GCM. The MPNS Api looks like this:++MPNS let you send notification in an authenticated or unauthenticated mode, so you can configure this with MPNSConfig:++ data MPNSConfig = MPNSConfig{+ numRet :: Int + , useSecure :: Bool + , certificate :: X509 + , privateKey :: PrivateKey+ }++To build messages, I developed a data type "MPNSmessage"++ data MPNSmessage = MPNSmessage{+ deviceURIs :: HashSet DeviceURI -- destinations+ , batching_interval :: MPNSInterval -- Immediate | Sec450 | Sec900+ , target :: MPNSType -- Toast | Raw | Tile+ , restXML :: Document -- the XML data to be sent+ }++For sending notifications:++ sendMPNS :: Manager -> MPNSConfig -> MPNSmessage -> IO MPNSresult++Last, for handling the result:++ data MPNSresult = MPNSresult{+ successfullResults :: HashMap DeviceURI MPNSinfo+ , errorException :: HashMap DeviceURI SomeException+ }++The code is available on GitHub:+ - The MPNS Api : [1]("https://github.com/MarcosPividori/GSoC-Communicating-with-mobile-devices/tree/master/push-notify/Network/PushNotify/Mpns")+ - Test example for MPNS: [2]("https://github.com/MarcosPividori/GSoC-Communicating-with-mobile-devices/tree/master/push-notify/test")+ - Yesod and MPNS app example: [3](https://github.com/MarcosPividori/GSoC-Communicating-with-mobile-devices/tree/master/test)++For more information about:+ - The MPNS Service:++ (http://msdn.microsoft.com/en-us/library/windowsphone/develop/ff402558(v=vs.105).aspx)+ - The communication with MPNS servers: ++ (http://msdn.microsoft.com/en-us/library/windowsphone/develop/hh202945(v=vs.105).aspx)
+ Network/PushNotify/Mpns/Send.hs view
@@ -0,0 +1,126 @@+-- GSoC 2013 - Communicating with mobile devices.++{-# LANGUAGE OverloadedStrings, FlexibleContexts #-}++-- | This Module define the main function to send Push Notifications through Microsoft Push Notification Service.+module Network.PushNotify.Mpns.Send (sendMPNS) where++import Network.PushNotify.Mpns.Constants+import Network.PushNotify.Mpns.Types++import Data.Functor+import Data.String+import Data.Conduit (($$+-))+import Data.List+import Data.Text (Text, pack, unpack, empty)+import Data.Text.Encoding (decodeUtf8)+import Text.XML+import qualified Control.Exception as CE+import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HS+import Control.Concurrent.Async+import Control.Monad.IO.Class (liftIO)+import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Resource (MonadResource,runResourceT)+import Control.Retry+import Network.HTTP.Types+import Network.HTTP.Conduit++retrySettingsMPNS = RetrySettings {+ backoff = True+, baseDelay = 100+, numRetries = limitedRetries 1+}++-- | 'sendMPNS' sends the message to a MPNS Server.+sendMPNS :: Manager -> MPNSConfig -> MPNSmessage -> IO MPNSresult+sendMPNS manager cnfg msg = do+ let uriList = HS.toList $ deviceURIs msg+ asyncs <- mapM (async . send manager cnfg msg) uriList+ results <- mapM waitCatch asyncs+ let list = zip uriList results+ (r,l) = partition (isRight . snd) list+ return $ MPNSresult{+ successfullResults = HM.map (\(Right y) -> y) $ HM.fromList r+ , errorException = HM.map (\(Left e) -> e) $ HM.fromList l+ }+ where+ isRight (Right _) = True+ isRight (Left _) = False++send :: Manager -> MPNSConfig -> MPNSmessage -> DeviceURI -> IO MPNSinfo+send manager cnfg msg deviceUri = runResourceT $ do+ req' <- liftIO $ case useSecure cnfg of+ False -> parseUrl $ unpack deviceUri+ True -> do+ r <- (parseUrl $ unpack deviceUri)+ return r{+ clientCertificates = [(mpnsCertificate cnfg, Just (mpnsPrivatekey cnfg))]+ , secure = True }+ let valueBS = renderLBS def $ restXML msg+ interval = case target msg of+ Tile -> 1+ Toast -> 2+ Raw -> 3+ + case batching_interval msg of+ Immediate -> 0+ Sec450 -> 10+ Sec900 -> 20+ req = req' {+ method = "POST"+ , requestBody = RequestBodyLBS valueBS+ , requestHeaders = [+ ("Content-Type", "text/xml")+ , (cNotificationClass, fromString $ show interval)+ ] ++ case target msg of+ Tile -> [(cWindowsPhoneTarget, cToken)]+ Toast -> [(cWindowsPhoneTarget, cToast)]+ Raw -> []+ }+ info <- liftIO $ CE.catch (runResourceT $ retry req manager (numRet cnfg))+ (\(StatusCodeException rStatus rHeaders c) -> case statusCode rStatus of+ 404 -> return $ handleSuccessfulResponse rHeaders+ 406 -> return $ handleSuccessfulResponse rHeaders+ 412 -> return $ handleSuccessfulResponse rHeaders+ _ -> CE.throw $ StatusCodeException rStatus rHeaders c )+ return info++-- 'retry' try numRet attemps to send the messages.+retry :: (MonadBaseControl IO m,MonadResource m)+ => Request m -> Manager -> Int -> m MPNSinfo+retry req manager numret = do+ response <- retrying (retrySettingsMPNS{numRetries = limitedRetries numret}) ifRetry $ http req manager+ responseBody response $$+- return ()+ if ifRetry response+ then CE.throw $ StatusCodeException (responseStatus response) (responseHeaders response) (responseCookieJar response)+ else return $ handleSuccessfulResponse $ responseHeaders response+ where+ ifRetry x = (statusCode $ responseStatus x) >= 500++-- 'handleSuccessfulResponse' analyzes the server response.+handleSuccessfulResponse :: ResponseHeaders -> MPNSinfo+handleSuccessfulResponse headers = MPNSinfo {+ notificationStatus = (decodeUtf8 <$> lookup cNotificationStatus headers ) >>= case1+ , subscriptionStatus = (decodeUtf8 <$> lookup cSubscriptionStatus headers ) >>= case2+ , connectionStatus = (decodeUtf8 <$> lookup cDeviceConnectionStatus headers) >>= case3+ }++case1 :: Text -> Maybe MPNSnotifStatus+case1 m | m== cNotifReceived = Just Received+ | m== cNotifDropped = Just Dropped+ | m== cNotifQueuefull = Just QueueFull+ | m== cNotifSuppressed = Just Suppressed+ | otherwise = Nothing++case2 :: Text -> Maybe MPNSsubStatus+case2 m | m== cSubActive = Just Active+ | m== cSubExpired = Just Expired+ | otherwise = Nothing++case3 :: Text -> Maybe MPNSconStatus+case3 m | m== cConnConnected = Just Connected+ | m== cConnInactive = Just InActive+ | m== cConnDisconnected = Just Disconnected+ | m== cConnTempDisconn = Just TempDisconnected+ | otherwise = Nothing+
+ Network/PushNotify/Mpns/Types.hs view
@@ -0,0 +1,104 @@+-- GSoC 2013 - Communicating with mobile devices.++{-# LANGUAGE OverloadedStrings #-}++-- | This Module define the main data types for sending Push Notifications through Microsoft Push Notification Service.+module Network.PushNotify.Mpns.Types+ ( -- * MPNS Settings+ MPNSConfig(..)+ , DeviceURI+ -- * MPNS Messages+ , MPNSType(..)+ , MPNSInterval(..)+ , MPNSmessage(..)+ -- * MPNS Result+ , MPNSresult(..)+ , MPNSinfo(..)+ , MPNSnotifStatus(..)+ , MPNSsubStatus(..)+ , MPNSconStatus(..)+ ) where++import Network.PushNotify.Mpns.Constants+import Network.TLS (PrivateKey)+import Data.Certificate.X509 (X509)+import Data.Default+import Data.Text+import Text.XML+import Control.Monad.Writer+import qualified Control.Exception as CE+import qualified Data.HashMap.Strict as HM+import qualified Data.HashSet as HS++-- | 'MPNSConfig' represents the main necessary information for sending notifications through MPNS.+-- If it is not necessary a secure connection, the default value can be used.+--+-- For loading the certificate and privateKey you can use: 'Network.TLS.Extra.fileReadCertificate' and 'Network.TLS.Extra.fileReadPrivateKey' .+data MPNSConfig = MPNSConfig{+ numRet :: Int -- ^ Number of attemps to send the message to the server.+ , useSecure :: Bool -- ^ To set a secure connection (HTTPS).+ , mpnsCertificate :: X509 -- ^ Certificate (only necessary for secure connections).+ , mpnsPrivatekey :: PrivateKey -- ^ Private key (only necessary for secure connections).+ } deriving Show++instance Default MPNSConfig where+ def = MPNSConfig{+ numRet = 5+ , useSecure = False+ , mpnsCertificate = undefined+ , mpnsPrivatekey = undefined+ }++-- | 'DeviceURI' is an unique identifier of an app/device, provided by MPNS.+type DeviceURI = Text++-- | 'MPNSType' represents the three different kind of notifications.+data MPNSType = Toast | Raw | Tile deriving Show++-- | 'MPNSType' represents the batching interval.+data MPNSInterval = Immediate -- ^ Immediate delivery.+ | Sec450 -- ^ Delivered within 450 seconds.+ | Sec900 -- ^ Delivered within 900 seconds.+ deriving Show++-- | 'MPNSmessage' represents a message to be sent through MPNS.+data MPNSmessage = MPNSmessage{+ deviceURIs :: HS.HashSet DeviceURI -- ^ Destination.+ , batching_interval :: MPNSInterval -- ^ When to deliver the notification.+ , target :: MPNSType -- ^ The kind of notification.+ , restXML :: Document -- ^ The XML data content to be sent.+ } deriving Show++instance Default MPNSmessage where+ def = MPNSmessage {+ deviceURIs = HS.empty+ , batching_interval = Immediate+ , target = Raw+ , restXML = parseText_ def ""+ }+++-- | 'MPNSresult' represents information about messages after a communication with MPNS Servers.+--+-- Take into account that a successful result after communicating with MPNS servers does not mean that the notification was successfully sent. It is necessary to check the 'MPNSinfo' , provided by the servers, to really know about the state of the notification.+data MPNSresult = MPNSresult{+ successfullResults :: HM.HashMap DeviceURI MPNSinfo -- ^ Notifications that were successfully sent. (To the server, not to device)+ , errorException :: HM.HashMap DeviceURI CE.SomeException -- ^ Failed notifications that you need to resend,+ -- because there was a problem connecting with MPNS servers.+ } deriving Show++-- | 'MPNSnotifStatus' represents the status of a notification which has been sent.+data MPNSnotifStatus = Received | Dropped | QueueFull | Suppressed deriving (Show,Eq)++-- | 'MPNSsubStatus' represents the status of a subscription.+data MPNSsubStatus = Active | Expired deriving (Show,Eq)++-- | 'MPNSconStatus' represents the status of a connection.+data MPNSconStatus = Connected | InActive | Disconnected | TempDisconnected deriving (Show,Eq)++-- | 'MPNSinfo' represents information about a specific notification and device, after a communication with MPNS Servers.+data MPNSinfo = MPNSinfo {+ notificationStatus :: Maybe MPNSnotifStatus+ , subscriptionStatus :: Maybe MPNSsubStatus+ , connectionStatus :: Maybe MPNSconStatus+ } deriving Show
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ push-notify.cabal view
@@ -0,0 +1,65 @@+name: push-notify+version: 0.1.0.0+synopsis: A server-side library for sending push notifications.+description: This library offers a simple abstraction for sending notifications through APNS, GCM and MPNS.+ .+ For more information and test examples: <http://gsoc2013cwithmobiledevices.blogspot.com.ar/>+ .+ GitHub repository: <https://github.com/MarcosPividori/GSoC-Communicating-with-mobile-devices>+homepage: http://gsoc2013cwithmobiledevices.blogspot.com.ar/+license: MIT+license-file: LICENSE+author: Marcos Pividori, mentored by Michael Snoyman.+maintainer: Marcos Pividori <marcos.pividori@gmail.com>++category: Network, Cloud, Mobile+build-type: Simple+cabal-version: >=1.8++library+ exposed-modules: Network.PushNotify.Gcm+ , Network.PushNotify.Gcm.Types+ , Network.PushNotify.Apns+ , Network.PushNotify.Mpns++ other-modules: Network.PushNotify.Gcm.Constants+ , Network.PushNotify.Gcm.Send+ , Network.PushNotify.Apns.Constants+ , Network.PushNotify.Apns.Send+ , Network.PushNotify.Apns.Types+ , Network.PushNotify.Mpns.Constants+ , Network.PushNotify.Mpns.Send+ , Network.PushNotify.Mpns.Types++ build-depends: base >=4.5 && <5+ , aeson >=0.6+ , async >=2.0+ , attoparsec-conduit >=1.0+ , base16-bytestring >=0.1+ , bytestring >=0.9+ , cereal >=0.3+ , certificate >=1.3+ , conduit >=1.0+ , containers >=0.4+ , convertible >=1.0+ , cprng-aes >=0.3+ , data-default >=0.5+ , http-conduit >=1.9+ , http-types >=0.8+ , monad-control >=0.3+ , mtl >=2.1+ , network >=2.4+ , resourcet >=0.4+ , retry >=0.3+ , stm >=2.3+ , text >=0.11+ , time >=1.4+ , tls >=1.1+ , tls-extra >=0.6+ , transformers >=0.3+ , unordered-containers >=0.2+ , xml-conduit >=1.1++source-repository head+ type: git+ location: https://github.com/MarcosPividori/GSoC-Communicating-with-mobile-devices.git