diff --git a/ChangeLog.md b/ChangeLog.md new file mode 100644 --- /dev/null +++ b/ChangeLog.md @@ -0,0 +1,5 @@ +# Revision history for push-notifications + +## 0.1.0.0 + +* Remove deprecated `pushMess` function 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/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,39 @@ +# push-notifications + +Server-side push messaging from Haskell to various platforms (currently supporting iOS and Android). + +## Android + +Push notifications to android devices are sent via Google's [Firebase](https://firebase.google.com) service. To send push notifications via Firebase, you'll need to create a project and acquire a "server key." + +To get your server key, go to the [Firebase console](https://console.firebase.google.com/) and create or open a project. On the project settings page, there is a "Cloud Messaging" section. On that page you should be able to retrieve or create a "server key." + +The server key should be passed to `Network.PushNotification.Android.sendAndroidPushMessage`. + +To construct an android push message payload, have a look at `Network.PushNotification.Android.Payload` which provides a haskell datatype and JSON instances for Firebase Cloud Messaging payloads (as documented [here](https://firebase.google.com/docs/cloud-messaging/http-server-ref)). + +## IOS + +Sending push notifications requires an "Apple Push Services" certificate and an Apple-provided device token. + +### Getting an APS Certificate +The APS certificate is produced in the iOS Provisioning Portal. Once you've generated the certificate, you can download it from the Provisioning Portal. It is usually named @aps_production.cer@ or @aps_development.cer@. + +The private key for the certificate can be extracted from Apple's Keychain utility as a @.p12@ file. + +Once you have both the certificate and private key, the following commands can be used to convert the certificate and private key files into the format required by this library. + +```bash +openssl x509 -in aps_development.cer -inform DER -outform PEM -out cert.pem +openssl pkcs12 -in key.p12 -out key.pem -nodes +``` + +### Getting a Device Token + +Device tokens are retrieved on the device itself by calling the @registerForRemoteNotifications@ method of the @UIApplication@ object. + +For more information, please see [Apple's documentation](https://developer.apple.com/library/content/documentation/NetworkingInternet/Conceptual/RemoteNotificationsPG/HandlingRemoteNotifications.html#//apple_ref/doc/uid/TP40008194-CH6-SW1 here). + +## Credits + +Originally based on a blog post by Teemu Ikonen, available [here](https://bravenewmethod.com/2012/11/08/apple-push-notifications-with-haskell/) and packaged by David Fendrich as the "phone-push" library on hackage. That library was eventually forked and updated and, eventually, became this one. 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/push-notifications.cabal b/push-notifications.cabal new file mode 100644 --- /dev/null +++ b/push-notifications.cabal @@ -0,0 +1,54 @@ +name: push-notifications +version: 0.2 +copyright: (c) 2019 Obsidian Systems and David Fendrich +license: BSD3 +license-file: LICENSE +maintainer: maintainer@obsidian.systems +build-type: Simple +cabal-version: >= 1.14 +homepage: https://github.com/obsidiansystems/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. + . +extra-source-files: + README.md + ChangeLog.md + +source-repository head + type: git + location: http://github.com/obsidiansystems/haskell-phone-push.git + +Library + Exposed-modules: + Network.PushNotification.Android + Network.PushNotification.Android.Payload + Network.PushNotification.IOS + Network.PushNotification.IOS.Payload + ghc-options: + -Wall + 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 + , http-types >= 0.8.0 + , resourcet >= 1.1.9 + , aeson + , text + , casing + , data-default diff --git a/src/Network/PushNotification/Android.hs b/src/Network/PushNotification/Android.hs new file mode 100644 --- /dev/null +++ b/src/Network/PushNotification/Android.hs @@ -0,0 +1,30 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Network.PushNotification.Android where + +import Data.Aeson (encode) +import Network.HTTP.Conduit + +import qualified Data.ByteString.Char8 as C8 +import qualified Data.ByteString as BS +import qualified Data.ByteString.Lazy as LBS + +import Network.PushNotification.Android.Payload + +-- | Sends a POST request to the firebase service containing the push notification data +sendAndroidPushMessage :: Manager + -> BS.ByteString -- ^ The server key (see README.md) + -> FcmPayload + -> IO (Response LBS.ByteString) +sendAndroidPushMessage mgr key p = do + target <- parseUrlThrow "https://fcm.googleapis.com/fcm/send" + let req = target + { method = "POST" + , requestHeaders = + [ ("Authorization", BS.append "key=" $ C8.takeWhile (/='\n') key) + , ("Content-Type", "application/json") + ] + , requestBody = RequestBodyLBS $ encode p + } + httpLbs req mgr diff --git a/src/Network/PushNotification/Android/Payload.hs b/src/Network/PushNotification/Android/Payload.hs new file mode 100644 --- /dev/null +++ b/src/Network/PushNotification/Android/Payload.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module: Network.PushNotification.Android.Payload +-- +-- Data type and JSON instances for Firebase Cloud Messaging payloads +-- For more information, please see . + +module Network.PushNotification.Android.Payload where + +import Data.Aeson.TH +import Data.Default +import Data.Text (Text) +import Text.Casing + +data FcmPayload = FcmPayload + { _fcmPayload_to :: Maybe Text + , _fcmPayload_registrationIds :: Maybe [Text] + , _fcmPayload_collapseKey :: Maybe Text + , _fcmPayload_priority :: Maybe Text + , _fcmPayload_contentAvailable :: Maybe Bool + , _fcmPayload_timeToLive :: Maybe Int + , _fcmPayload_restrictedPackageName :: Maybe Text + , _fcmPayload_dryRun :: Maybe Bool + , _fcmPayload_notification :: Maybe FcmNotification + , _fcmPayload_data :: Maybe FcmData + } + deriving (Show, Read, Eq, Ord) + +data FcmData = FcmData + { _fcmData_custom :: Text + } + deriving (Show, Read, Eq, Ord) + +instance Default FcmPayload where + def = FcmPayload + { _fcmPayload_to = Nothing + , _fcmPayload_registrationIds = Nothing + , _fcmPayload_collapseKey = Nothing + , _fcmPayload_priority = Nothing + , _fcmPayload_contentAvailable = Nothing + , _fcmPayload_timeToLive = Nothing + , _fcmPayload_restrictedPackageName = Nothing + , _fcmPayload_dryRun = Nothing + , _fcmPayload_notification = Nothing + , _fcmPayload_data = Nothing + } + +data FcmNotification = FcmNotification + { _fcmNotification_title :: Maybe Text + , _fcmNotification_body :: Maybe Text + , _fcmNotification_androidChannelId :: Maybe Text + , _fcmNotification_icon :: Maybe Text + , _fcmNotification_sound :: Maybe Text + , _fcmNotification_tag :: Maybe Text + , _fcmNotification_color :: Maybe Text + , _fcmNotification_clickAction :: Maybe Text + } + deriving (Show, Read, Eq, Ord) + +instance Default FcmNotification where + def = FcmNotification + { _fcmNotification_title = Nothing + , _fcmNotification_body = Nothing + , _fcmNotification_androidChannelId = Nothing + , _fcmNotification_icon = Nothing + , _fcmNotification_sound = Nothing + , _fcmNotification_tag = Nothing + , _fcmNotification_color = Nothing + , _fcmNotification_clickAction = Nothing + } + +$(deriveJSON (defaultOptions { fieldLabelModifier = toQuietSnake . fromHumps . drop 9 }) ''FcmData) +$(deriveJSON (defaultOptions { fieldLabelModifier = toQuietSnake . fromHumps . drop 17, omitNothingFields = True}) ''FcmNotification) +$(deriveJSON (defaultOptions { fieldLabelModifier = toQuietSnake . fromHumps . drop 12, omitNothingFields = True}) ''FcmPayload) diff --git a/src/Network/PushNotification/IOS.hs b/src/Network/PushNotification/IOS.hs new file mode 100644 --- /dev/null +++ b/src/Network/PushNotification/IOS.hs @@ -0,0 +1,170 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module: Network.PushNotification.IOS +-- +-- Apple Push Notification Service provider +-- +-- Sending push notifications requires an "Apple Push Services" certificate and +-- an Apple-provided device token. +-- +-- == Getting an APS Certificate +-- +-- The APS certificate is produced in the iOS Provisioning Portal. Once you've +-- generated the certificate, you can download it from the Provisioning Portal. +-- It is usually named @aps_production.cer@ or @aps_development.cer@. +-- +-- The private key for the certificate can be extracted from Apple's Keychain +-- utility as a @.p12@ file. +-- +-- Once you have both the certificate and private key, the following commands +-- can be used to convert the certificate and private key files into the format +-- required by this library. +-- +-- > openssl x509 -in aps_development.cer -inform DER -outform PEM -out cert.pem +-- > openssl pkcs12 -in key.p12 -out key.pem -nodes +-- +-- == Getting a Device Token +-- +-- Device tokens are retrieved from Apple on the device itself by calling +-- the @registerForRemoteNotifications@ method of the @UIApplication@ object. +-- For more information, please see Apple's documentation . +-- +-- == Credits +-- Originally based on a blog post by Teemu Ikonen, available . + +module Network.PushNotification.IOS where + +import Data.Binary.Put +import Data.Convertible (convert) +import GHC.Word (Word32, Word16) +import qualified Data.ByteString as B +import qualified Data.ByteString.Lazy as BL + +import Data.Time.Clock.POSIX (getPOSIXTime) + +import Network.BSD (getHostByName, hostAddress, getProtocolNumber) +import Network.Socket +import OpenSSL +import OpenSSL.Session as SSL + +data APNSConfig = APNSConfig + { _APNSConfig_server :: String + , _APNSConfig_key :: FilePath + , _APNSConfig_certificate :: FilePath + } + deriving (Show, Read, Eq, Ord) + +gatewayLive :: String +gatewayLive = "gateway.push.apple.com" + +gatewayTest :: String +gatewayTest = "gateway.sandbox.push.apple.com" + +feedbackLive :: String +feedbackLive = "feedback.push.apple.com" + +feedbackTest :: String +feedbackTest = "feedback.sandbox.push.apple.com" + +data ApplePushMessage = ApplePushMessage + { _applePushMessage_deviceToken :: B.ByteString + , _applePushMessage_payload :: BL.ByteString + -- ^ JSON encoded payload, conforming to . See "PhonePush.IOS.Payload" + , _applePushMessage_expiry :: Word32 + } + +checkFailLive :: FilePath -> FilePath -> IO [B.ByteString] +checkFailLive = checkFail feedbackLive + +checkFailTest :: FilePath -> FilePath -> IO [B.ByteString] +checkFailTest = checkFail feedbackTest + +checkFail :: String -> FilePath -> FilePath -> IO [B.ByteString] +checkFail server keyfile certfile = withOpenSSL $ do + ssl <- context + contextSetPrivateKeyFile ssl keyfile + contextSetCertificateFile ssl certfile + contextSetDefaultCiphers ssl + contextSetVerificationMode ssl SSL.VerifyNone + + proto <- getProtocolNumber "tcp" + he <- getHostByName server + sock <- socket AF_INET Stream proto + Network.Socket.connect sock (SockAddrInet 2196 (hostAddress he)) + + sslsocket <- connection ssl sock + SSL.connect sslsocket -- Handshake + bs <- SSL.read sslsocket 7600000 + print $ B.length bs + SSL.shutdown sslsocket Unidirectional + + return $ splitBS bs + +-- | Opens an APNS connection, runs the supplied action with the SSL socket, and closes the connection. +-- +-- Example usage: +-- +-- > withAPNSSocket cfg $ \sslsocket -> sendApplePushMessage msg sslsocket +-- +-- Note that in practice you should keep the SSL socket open and re-use it. From the : +-- \"APNs treats rapid connection and disconnection as a denial-of-service attack.\" +withAPNSSocket :: APNSConfig -> (SSL -> IO ()) -> IO () +withAPNSSocket (APNSConfig server keyfile certfile) f = 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 server + 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 + -- Use socket + f sslsocket + -- Close gracefully + SSL.shutdown sslsocket Unidirectional + +-- | Send a message through the SSL socket +sendApplePushMessage :: SSL -> ApplePushMessage -> IO () +sendApplePushMessage sslsocket m = + let lpdu = runPut $ buildPDU m + pdu = B.concat $ BL.toChunks lpdu + in SSL.write sslsocket pdu + +tokenLength :: Num a => a +tokenLength = 32 + +maxPayloadLength :: Num a => a +maxPayloadLength = 2048 + +buildPDU :: ApplePushMessage -> Put +buildPDU (ApplePushMessage token payload expiry) + | B.length token /= tokenLength = fail "Invalid token" + | BL.length payload >= maxPayloadLength = fail "Payload too large" + | otherwise = do + putWord8 1 + putWord32be 1 + putWord32be expiry + putWord16be ((convert $ B.length token) :: Word16) + putByteString token + putWord16be ((convert $ BL.length payload) :: Word16) + putLazyByteString payload + +splitBS :: B.ByteString -> [B.ByteString] +splitBS xs = + let xs1 = B.drop 6 xs + token = B.take 32 xs1 + nexst = B.drop 32 xs1 + in if B.null token then [] else token : splitBS nexst + +getExpiryTime :: IO Word32 +getExpiryTime = do + pt <- getPOSIXTime + -- One hour expiry time + return ( (round pt + 60*60):: Word32) diff --git a/src/Network/PushNotification/IOS/Payload.hs b/src/Network/PushNotification/IOS/Payload.hs new file mode 100644 --- /dev/null +++ b/src/Network/PushNotification/IOS/Payload.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} + +module Network.PushNotification.IOS.Payload where + +import Data.Aeson.TH +import Data.Default +import Data.Text (Text) +import Text.Casing + +data ApsPayload = ApsPayload + { _apsPayload_aps :: Aps + , _apsPayload_custom :: Maybe Text + } + deriving (Show, Read, Eq, Ord) + +instance Default ApsPayload where + def = ApsPayload def Nothing + +data Aps = Aps + { _aps_alert :: Maybe ApsAlert + -- ^ The alert content + , _aps_badge :: Maybe Int + -- ^ The unread count to display on the application icon + , _aps_sound :: Maybe Text + -- ^ The filename of the sound to play on notification + , _aps_contentAvailable :: Maybe Int + -- ^ Used for + , _aps_category :: Maybe Text + -- ^ The app-specific + , _aps_threadId :: Maybe Text + -- ^ The app-specific messaging thread identifier, used to group notifications + } + deriving (Show, Read, Eq, Ord) + +instance Default Aps where + def = Aps + { _aps_alert = Nothing + , _aps_badge = Nothing + , _aps_sound = Nothing + , _aps_contentAvailable = Nothing + , _aps_category = Nothing + , _aps_threadId = Nothing + } + +data ApsAlert = ApsAlert + { _apsAlert_title :: Text + , _apsAlert_body :: Text + , _apsAlert_launchImage :: Maybe Text + } + deriving (Show, Read, Eq, Ord) + +instance Default ApsAlert where + def = ApsAlert + { _apsAlert_title = "" + , _apsAlert_body = "" + , _apsAlert_launchImage = Nothing + } + +$(deriveJSON (defaultOptions { fieldLabelModifier = toKebab . fromHumps . drop 10, omitNothingFields = True }) ''ApsAlert) +$(deriveJSON (defaultOptions { fieldLabelModifier = toKebab . fromHumps . drop 5, omitNothingFields = True }) ''Aps) +$(deriveJSON (defaultOptions { fieldLabelModifier = toKebab . fromHumps . drop 12, omitNothingFields = True }) ''ApsPayload)