apns-http2 0.1.0.0 → 0.1.1.0

raw patch · 4 files changed

+83/−52 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• apns-http2.cabal +19/−16
• example/Main.hs +32/−19
• src/Network/Apns/Internal.hs +25/−15
• src/Network/Apns/Types.hs +7/−2

@@ -1,29 +1,31 @@--- This file has been generated from package.yaml by hpack version 0.18.1.+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack+--+-- hash: db7c14d46fbfd626dfd55743886a8027e59c28ee11fce7ea2e14e693bacba209  name:           apns-http2-version:        0.1.0.0+version:        0.1.1.0 synopsis:       Apple Push Notification service HTTP/2 integration. category:       Network-homepage:       https://github.com/ConferHealth/apns-http2#readme+homepage:       https://github.com/ConferOpenSource/apns-http2#readme author:         Confer Health, Inc.-maintainer:     oss@confer.health-copyright:      2017 Confer Health, Inc.+maintainer:     oss@vitalbio.com+copyright:      2017 Confer Health, Inc., 2020 Vital Biosciences license:        BSD3 license-file:   LICENSE build-type:     Simple-cabal-version:  >= 1.10  library   hs-source-dirs:       src-  default-extensions: FlexibleContexts FlexibleInstances LambdaCase NamedFieldPuns NoMonomorphismRestriction OverloadedStrings QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables TemplateHaskell TupleSections ViewPatterns   ghc-options: -Wall -O2   build-depends:-      base >= 4.7 && < 5-    , aeson+      aeson     , async+    , base >=4.7 && <5     , bytestring     , conduit     , conduit-extra@@ -57,12 +59,14 @@   main-is: Main.hs   hs-source-dirs:       example-  default-extensions: FlexibleContexts FlexibleInstances LambdaCase NamedFieldPuns NoMonomorphismRestriction OverloadedStrings QuasiQuotes RankNTypes RecordWildCards ScopedTypeVariables TemplateHaskell TupleSections ViewPatterns   ghc-options: -Wall -O2 -threaded -rtsopts -with-rtsopts=-N   build-depends:-      base >= 4.7 && < 5-    , aeson+      aeson+    , aeson-qq+    , apns-http2     , async+    , base >=4.7 && <5+    , base16-bytestring     , bytestring     , conduit     , conduit-extra@@ -83,9 +87,8 @@     , tls     , x509     , x509-store-    , x509-validation-    , aeson-qq-    , apns-http2-    , base16-bytestring     , x509-system+    , x509-validation+  other-modules:+      Paths_apns_http2   default-language: Haskell2010

@@ -1,5 +1,11 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ViewPatterns #-} module Main where +import Control.Concurrent (threadDelay) import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar) import Data.Aeson (encode) import Data.Aeson.QQ (aesonQQ)@@ -7,6 +13,7 @@ import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BSC8 import qualified Data.ByteString.Lazy as BL+import Data.Foldable (for_) import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Data.Text.IO as TIO@@ -49,28 +56,34 @@     Left connectError ->       putStrLn $ "Failed to connect: " <> show connectError     Right connection -> do-      now <- getCurrentTime-      let _apnsPushData_deviceToken = deviceToken-          _apnsPushData_expiration = addUTCTime (86400*2) now-          _apnsPushData_priority = Nothing-          _apnsPushData_topic = topic-          _apnsPushData_collapseId = Nothing-          _apnsPushData_payload = BL.toStrict $ encode [aesonQQ|-            {-              "aps": {-                "alert": {-                  "title": "Hello, APNs!",-                  "body": "If you're reading this you're too close to a working integration"+      for_ [1..(100 :: Int)] $ \ _ -> do+        now <- getCurrentTime+        let _apnsPushData_deviceToken = deviceToken+            _apnsPushData_expiration = addUTCTime (86400*2) now+            _apnsPushData_priority = Nothing+            _apnsPushData_topic = topic+            _apnsPushData_collapseId = Nothing+            _apnsPushData_payload = BL.toStrict $ encode [aesonQQ|+              {+                "aps": {+                  "alert": {+                    "title": "Hello, APNs!",+                    "body": "If you're reading this you're too close to a working integration"+                  },+                  "badge": 1                 },-                "badge": 1+                "additionalStuff": "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",+                "additionalStuff5": "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"               }-            }-            |]+              |] -      _apnsConnection_submitPush connection $ ApnsPush (ApnsPushData {..}) $ \ res -> do-        putStrLn . ("push result: " <>) . show $ res-        putStrLn "closing connection"-        _apnsConnection_close connection+        _apnsConnection_submitPush connection $ ApnsPush (ApnsPushData {..}) $ \ res -> do+          putStrLn . ("push result: " <>) . show $ res++        threadDelay 2000000++      putStrLn "closing connection"+      _apnsConnection_close connection        terminationReason <- takeMVar terminationMv       putStrLn . ("Connection terminated: " <>) . show $ terminationReason

@@ -1,3 +1,12 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE ViewPatterns #-} module Network.Apns.Internal where  import Control.Applicative ((<|>))@@ -23,12 +32,13 @@ import Data.Aeson ((.:), (.:?), Value, eitherDecode', withObject) import Data.Aeson.Types (Parser, parseEither) import Data.Bifunctor (first)+import Data.Bool (bool) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Builder (byteStringHex, toLazyByteString) import qualified Data.ByteString.Char8 as BSC8 import qualified Data.ByteString.Lazy as BL-import Data.Conduit (ConduitM, Producer, (.|), ($$), awaitForever, yield)+import Data.Conduit (ConduitT, (.|), awaitForever, yield, runConduit) import qualified Data.Conduit.Binary as CB import qualified Data.Conduit.List as CL import Data.Conduit.TQueue (sinkTBMQueue, sourceTBMQueue)@@ -59,7 +69,6 @@   , ApnsPushResult(..)   , ApnsTerminationReason(..)   )-import Network.BSD (getProtocolNumber) import qualified Network.HPACK as HP import qualified Network.HTTP2 as H2 import Network.Socket (Socket)@@ -207,10 +216,8 @@      connectSocket :: ExceptT ApnsConnectionError IO Socket     connectSocket = do-      tcp <- liftIO $ getProtocolNumber "tcp"       let hints = Socket.defaultHints             { Socket.addrFlags      = [Socket.AI_ADDRCONFIG]-            , Socket.addrProtocol   = tcp             , Socket.addrSocketType = Socket.Stream             }       addressInfos <- liftIO $ Socket.getAddrInfo (Just hints) (Just _apnsConnectionParams_hostName) (Just . show $ _apnsConnectionParams_portNumber)@@ -358,6 +365,7 @@       unless (connWindow <= 0) $ do         let toWriteSize = min maxFrameSize . min connWindow . view writableStream_windowSize $ ws             (toWriteBs, remainingBs) = BS.splitAt toWriteSize . view writableStream_remaining $ ws+            didWriteSize = BS.length toWriteBs          if BS.null remainingBs           then do@@ -369,10 +377,10 @@             processorDebug $ "stream " <> (pack . show) sid <> " writing " <> (pack . show) toWriteSize <> " bytes with " <> (pack . show) (BS.length remainingBs) <> " bytes to go"             processorWrite (H2.encodeInfo id sid) (H2.DataFrame toWriteBs)             modifying (state_writableStreams . at sid . _Just)-              $ over writableStream_windowSize (subtract toWriteSize)+              $ over writableStream_windowSize (subtract didWriteSize)               . set writableStream_remaining remainingBs -        modifying state_connectionWindow (subtract toWriteSize)+        modifying state_connectionWindow (subtract didWriteSize)          go wses @@ -726,11 +734,11 @@ -- |Reader thread. Before this exits, some debug log will be emitted, the socket will be shut down for reads, and the reader queue will be closed. reader :: (Text -> IO ()) -> TLS.Context -> Socket -> TBMQueue ReaderEvent -> IO () reader debugLog tlsContext sock readerQueue = do-  res <- try+  res <- try $ runConduit     $  sourceTls-    $$ decodeH2Frames H2.defaultSettings+    .| decodeH2Frames H2.defaultSettings     .| CL.iterM (debugLog . ("received: " <>) . pack . show)-    .| sinkTBMQueue readerQueue True+    .| sinkTBMQueue readerQueue    atomically $ closeTBMQueue readerQueue   invokeWithoutException $ Socket.shutdown sock Socket.ShutdownReceive@@ -743,20 +751,23 @@       debugLog "reader ended normally"    where-    sourceTls :: Producer IO ByteString+    sourceTls :: forall i. ConduitT i ByteString IO ()     sourceTls =       liftIO (TLS.recvData tlsContext) >>= \ case         bs | BS.null bs -> pure ()            | otherwise  -> yield bs >> sourceTls -    decodeH2Frames :: H2.Settings -> ConduitM ByteString ReaderEvent IO ()+    decodeH2Frames :: H2.Settings -> ConduitT ByteString ReaderEvent IO ()     decodeH2Frames settings = do       let continue (eventMay, settings') = traverse_ yield eventMay >> decodeH2Frames settings'        either yield continue <=< runExceptT $ do         headerBytes <- lift $ BL.toStrict <$> CB.take H2.frameHeaderLength         when (BS.length headerBytes < H2.frameHeaderLength) $-          throwError (ReadH2Error H2.ProtocolError "Insufficient header bytes" ApnsTerminatedInsufficientHeaderBytes)+          bool+            (throwError (ReadH2Error H2.ProtocolError "Insufficient header bytes" ApnsTerminatedInsufficientHeaderBytes))+            (throwError (ReadH2Error H2.StreamClosed "Closed with no data" ApnsTerminatedSilentlyClosed))+            (BS.null headerBytes)          (frameType, frameHeader) <-           either (\ h2Error -> throwError $ ReadH2Error (H2.errorCodeId h2Error) (BSC8.pack . show $ h2Error) (ApnsTerminatedHttp2Error h2Error)) pure $@@ -790,9 +801,9 @@ -- |Writer thread. Before this exits, some debug log will be emitted, the socket will be shut down for writes, and the writer queue will be closed. writer :: (Text -> IO ()) -> TLS.Context -> Socket -> TBMQueue (H2.EncodeInfo, H2.FramePayload) -> IO () writer debugLog tlsContext sock writerQueue = do-  res <- try+  res <- try $ runConduit     $  sourceTBMQueue writerQueue-    $$ CL.iterM (debugLog . ("sending: " <>) . pack . show)+    .| CL.iterM (debugLog . ("sending: " <>) . pack . show)     .| CL.concatMap (map BL.fromStrict . uncurry H2.encodeFrameChunks)     .| awaitForever (TLS.sendData tlsContext) @@ -807,4 +818,3 @@       throwIO ex     Right _ ->       debugLog "writer ended normally"-

@@ -1,3 +1,6 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-} -- |Public types for using the APNs integration. module Network.Apns.Types   ( ApnsPushData(..), apnsPushData_deviceToken, apnsPushData_expiration, apnsPushData_priority, apnsPushData_topic, apnsPushData_collapseId, apnsPushData_payload@@ -145,7 +148,7 @@ -- |The result of a push delivery attempt. data ApnsPushResult   = ApnsPushDelivered ByteString-  -- ^The push was successfully delivered to APNs along with its assigned @apns-id@. It may or may not be delivered to the target device, at the discretion +  -- ^The push was successfully delivered to APNs along with its assigned @apns-id@. It may or may not be delivered to the target device, at the discretion   -- of APNs.   | ApnsPushErrored ApnsError   -- ^APNs rejected the push notification. See the 'ApnsError' for more detail.@@ -179,10 +182,12 @@   = ApnsTerminatedLocally   -- ^The APNs connection was locally closed using '_apnsConnection_close'.   | ApnsTerminatedRemotely (Either ByteString ApnsErrorReason)-  -- ^The APNs connection was remotely closed by APNs. The APNs error reason is given as @Right@ if available, otherwise some other error string +  -- ^The APNs connection was remotely closed by APNs. The APNs error reason is given as @Right@ if available, otherwise some other error string   -- given as @Left@.   | ApnsTerminatedHttp2Error HTTP2Error   -- ^The APNs connection was terminated due to an HTTP/2 protocol error.+  | ApnsTerminatedSilentlyClosed+  -- ^The APNs connection was terminated because a foreign entity closed the TCP stream and no reason was provided.   | ApnsTerminatedInsufficientHeaderBytes   -- ^The APNs connection was terminated because the TCP stream ended before being able to read all the header bytes for an HTTP/2 frame.   | ApnsTerminatedInsufficientPayloadBytes FrameTypeId