phone-push (empty) → 0.1.0

raw patch · 5 files changed

+185/−0 lines, 5 filesdep +HsOpenSSLdep +basedep +base16-bytestringsetup-changed

Dependencies added: HsOpenSSL, base, base16-bytestring, binary, bytestring, conduit, convertible, http-conduit, network, time, transformers

Files

LICENSE +30/−0
Setup.hs +2/−0
phone-push.cabal +44/−0
src/Android.hs +35/−0
src/IOS.hs +74/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright David Fendrich 2013++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of David Fendrich nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"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 COPYRIGHT+OWNER 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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ phone-push.cabal view

@@ -0,0 +1,44 @@+name:             phone-push+version:          0.1.0+copyright:        (c) 2013 David Fendrich+license:          BSD3+license-file:     LICENSE+maintainer:       David Fendrich <david@aitellu.com>+build-type:       Simple+cabal-version:    >= 1.14+homepage:         https://github.com/gurgeh/haskell-phone-push+category:         Network APIs+stability:        experimental+synopsis:         Push notifications for Android and iOS+description:      Push notifications for Android and iOS+                  .+                  Functions for sending push notifications to popular mobile platforms.+                  .++source-repository head+  type: git+  location: http://github.com/gurgeh/haskell-phone-push.git++Library+  Exposed-modules:+      Android+      IOS+  ghc-options:+      -Wall -fno-warn-unused-do-bind+  default-language:+      Haskell2010+  hs-source-dirs:+      src+  build-depends:+      base >= 4 && <= 5+    , bytestring >= 0.9.2.1+    , transformers >= 0.3.0.0+    , conduit >= 1.0.0+    , http-conduit >= 1.9.1+    , HsOpenSSL >= 0.10.3.3+    , network >= 2.4.1.2+    , time >= 1.4+    , base16-bytestring >= 0.1.1.5+    , convertible >= 1.0.11.1+    , binary >= 0.5.1.0+

+ src/Android.hs view

@@ -0,0 +1,35 @@+{-# LANGUAGE TemplateHaskell, OverloadedStrings #-}++module Android (pushMess) where ++import Network.HTTP.Conduit+import Data.Conduit+import Control.Monad.IO.Class (liftIO)++import Data.ByteString.Lazy.Char8 (unpack)++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS++{-+Remove printing++Resend with exponential fallback+-}++pushMess :: BS.ByteString -> LBS.ByteString -> IO ()+pushMess apikey payload =+   runResourceT $ do+     liftIO $ print payload+     manager <- liftIO $ newManager def+     req <- liftIO $ parseUrl "https://android.googleapis.com/gcm/send"+     res <- httpLbs req {method = "POST",+                         requestHeaders = [("Authorization", BS.append "key=" apikey),+                                           ("Content-Type", "application/json")],+                         requestBody = RequestBodyLBS payload} manager+     liftIO $ do+       print $ unpack payload+       print $ responseStatus res+       print $ responseBody res+       mapM_ print $ responseHeaders res+

+ src/IOS.hs view

@@ -0,0 +1,74 @@+{-# LANGUAGE OverloadedStrings #-}++module IOS (pushMess) where++import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as BL+import Data.Binary.Put+import GHC.Word (Word32, Word16)+import Data.Convertible (convert)++import qualified Data.ByteString.Base16 as B16++import Data.Time.Clock.POSIX (getPOSIXTime)++import Network.Socket+import Network.BSD (getHostByName, hostAddress, getProtocolNumber)+import OpenSSL+import OpenSSL.Session as SSL+  +{-+show link to source++Sandbox choice+-}+  +pushMess:: FilePath -> FilePath -> BL.ByteString -> [B.ByteString] -> IO ()  +pushMess keyfile certfile payload tokens = withOpenSSL $ do+  -- Prepare SSL context+  ssl <- context+  contextSetPrivateKeyFile ssl keyfile+  contextSetCertificateFile ssl certfile+  contextSetDefaultCiphers ssl+  contextSetVerificationMode ssl SSL.VerifyNone++  -- Open socket+  proto <- (getProtocolNumber "tcp")+  he <- getHostByName "gateway.sandbox.push.apple.com"+  sock <- socket AF_INET Stream proto+  Network.Socket.connect sock (SockAddrInet 2195 (hostAddress he))++  -- Promote socket to SSL stream+  sslsocket <- connection ssl sock+  SSL.connect sslsocket  -- Handshake++  expiration <- getExpiryTime+  let sendPDU token =+        let btoken = fst $ B16.decode token+            lpdu = runPut $ buildPDU btoken payload expiration+            pdu = B.concat $ BL.toChunks lpdu+        in +          SSL.write sslsocket pdu+  sequence_ $ map sendPDU tokens+  SSL.shutdown sslsocket Unidirectional -- Close gracefully+++buildPDU :: B.ByteString -> BL.ByteString -> Word32 -> Put+buildPDU token payload expiry+  | (B.length token) /= 32 = fail "Invalid token"+  | (BL.length payload > 255) = fail "Too long payload"+  | otherwise = do+    putWord8 1+    putWord32be 1+    putWord32be expiry+    putWord16be ((convert $ B.length token) :: Word16)+    putByteString token+    putWord16be ((convert $ BL.length payload) :: Word16)+    putLazyByteString payload+++getExpiryTime :: IO (Word32)+getExpiryTime = do+  pt <- getPOSIXTime+  -- One hour expiry time+  return ( (round pt + 60*60):: Word32)