packages feed

push-notifications (empty) → 0.2

raw patch · 9 files changed

+467/−0 lines, 9 filesdep +HsOpenSSLdep +aesondep +basesetup-changed

Dependencies added: HsOpenSSL, aeson, base, base16-bytestring, binary, bytestring, casing, conduit, convertible, data-default, http-conduit, http-types, network, resourcet, text, time, transformers

Files

+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for push-notifications++## 0.1.0.0++* Remove deprecated `pushMess` function
+ 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.
+ README.md view
@@ -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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ push-notifications.cabal view
@@ -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
+ src/Network/PushNotification/Android.hs view
@@ -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
+ src/Network/PushNotification/Android/Payload.hs view
@@ -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 <https://firebase.google.com/docs/cloud-messaging/http-server-ref Google's documentation>.++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)
+ src/Network/PushNotification/IOS.hs view
@@ -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 <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 <https://bravenewmethod.com/2012/11/08/apple-push-notifications-with-haskell/ here>.++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 <https://developer.apple.com/library/content/documentation/NetworkingInternet/Conceptual/RemoteNotificationsPG/PayloadKeyReference.html#//apple_ref/doc/uid/TP40008194-CH17-SW1 this specification>. 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 <https://developer.apple.com/library/content/documentation/NetworkingInternet/Conceptual/RemoteNotificationsPG/CommunicatingwithAPNs.html#//apple_ref/doc/uid/TP40008194-CH11-SW1 Apple documentation>:+-- \"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)
+ src/Network/PushNotification/IOS/Payload.hs view
@@ -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 <https://developer.apple.com/library/content/documentation/NetworkingInternet/Conceptual/RemoteNotificationsPG/CreatingtheNotificationPayload.html#//apple_ref/doc/uid/TP40008194-CH10-SW8 silent notifications>+  , _aps_category :: Maybe Text+  -- ^ The app-specific <https://developer.apple.com/library/content/documentation/NetworkingInternet/Conceptual/RemoteNotificationsPG/SupportingNotificationsinYourApp.html#//apple_ref/doc/uid/TP40008194-CH4-SW26 notification category>+  , _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)