diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/phone-push.cabal b/phone-push.cabal new file mode 100644 --- /dev/null +++ b/phone-push.cabal @@ -0,0 +1,44 @@ +name: phone-push +version: 0.1.0 +copyright: (c) 2013 David Fendrich +license: BSD3 +license-file: LICENSE +maintainer: David Fendrich +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 + diff --git a/src/Android.hs b/src/Android.hs new file mode 100644 --- /dev/null +++ b/src/Android.hs @@ -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 + diff --git a/src/IOS.hs b/src/IOS.hs new file mode 100644 --- /dev/null +++ b/src/IOS.hs @@ -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)