push-notify-apn 0.3.0.0 → 0.3.0.1
raw patch · 3 files changed
+28/−22 lines, 3 files
Files
- changelog.md +5/−0
- push-notify-apn.cabal +7/−1
- src/Network/PushNotify/APN.hs +16/−21
changelog.md view
@@ -1,3 +1,8 @@+0.3.0.1+=======++- Tighten compile flags and fix some errors+ 0.3.0.0 =======
push-notify-apn.cabal view
@@ -1,5 +1,5 @@ name: push-notify-apn-version: 0.3.0.0+version: 0.3.0.1 synopsis: Send push notifications to mobile iOS devices description: push-notify-apn is a library and command line utility that can be used to send@@ -42,6 +42,12 @@ , x509 , x509-store , x509-system++ ghc-options:+ -Wall -W -fwarn-unused-imports -fwarn-unused-binds -fwarn-orphans+ -fwarn-unused-matches -fwarn-unused-do-bind -fwarn-wrong-do-bind+ -fwarn-missing-signatures -fno-warn-partial-type-signatures+ -Wredundant-constraints default-language: Haskell2010
src/Network/PushNotify/APN.hs view
@@ -51,7 +51,6 @@ ) where import Control.Concurrent-import Control.Concurrent.QSem import Control.Exception.Lifted (Exception, try, bracket_, throw, throwIO) import Control.Monad import Control.Monad.Except@@ -61,29 +60,22 @@ import Data.Char (toLower) import Data.Default (def) import Data.Either-import Data.Int import Data.IORef import Data.Map.Strict (Map) import Data.Maybe import Data.Pool-import Data.Semigroup ((<>)) import Data.Text (Text) import Data.Time.Clock-import Data.Time.Clock.POSIX import Data.Typeable (Typeable)-import Data.X509 import Data.X509.CertificateStore import GHC.Generics import Network.HTTP2.Frame (ErrorCodeId, toErrorCodeId) import "http2-client" Network.HTTP2.Client-import "http2-client" Network.HTTP2.Client.FrameConnection import "http2-client" Network.HTTP2.Client.Helpers import Network.TLS hiding (sendData) import Network.TLS.Extra.Cipher import System.IO.Error-import System.Mem.Weak-import System.Random import System.Timeout (timeout) import System.X509 @@ -125,9 +117,6 @@ -- | An APN token used to uniquely identify a device newtype ApnToken = ApnToken { unApnToken :: ByteString } -class SpecifyError a where- isAnError :: IOError -> a- -- | Create a token from a raw bytestring rawToken :: ByteString@@ -473,10 +462,16 @@ True -> pure False False -> do castore <- maybe (pure Nothing) readCertificateStore $ aciCaPath aci- credential <- case (aciCertPath aci, aciCertKey aci) of+ credential <- loadCredentials aci+ return $ isJust castore && isRight credential++loadCredentials :: ApnConnectionInfo -> IO (Either String Credential)+loadCredentials aci =+ case (aciCertPath aci, aciCertKey aci) of (Just cert, Just key) -> credentialLoadX509 cert key+ (Just _, Nothing) -> pure $ Left "no cert"+ (Nothing, Just _) -> pure $ Left "no key" (Nothing, Nothing) -> pure $ Left "no creds"- return $ isJust castore && isRight credential newConnection :: ApnConnectionInfo -> IO ApnConnection newConnection aci = do@@ -492,8 +487,7 @@ clip <- case (aciUseJWT aci) of True -> do castore <- getSystemCertificateStore- let maxConcurrentStreams = aciMaxConcurrentStreams aci- clip = ClientParams+ let clip = ClientParams { clientUseMaxFragmentLength=Nothing , clientServerIdentification=(T.unpack hostname, undefined) , clientUseServerNameIndication=True@@ -511,9 +505,7 @@ pure clip False -> do Just castore <- maybe (pure Nothing) readCertificateStore $ aciCaPath aci- Right credential <- case (aciCertPath aci, aciCertKey aci) of- (Just cert, Just key) -> credentialLoadX509 cert key- (Nothing, Nothing) -> pure $ Left "no creds"+ Right credential <- loadCredentials aci let credentials = Credentials [credential] shared = def { sharedCredentials = credentials , sharedCAStore=castore }@@ -535,7 +527,7 @@ pure clip isOpen <- newIORef True- let handleGoAway rsgaf = do+ let handleGoAway _rsgaf = do lift $ writeIORef isOpen False return () client <-@@ -546,7 +538,7 @@ linkAsyncs client return client flowWorker <- forkIO $ forever $ do- updated <- runClientIO $ _updateWindow $ _incomingFlowControl client+ _updated <- runClientIO $ _updateWindow $ _incomingFlowControl client threadDelay 1000000 workersem <- newQSem maxConcurrentStreams return $ ApnConnection client aci workersem flowWorker isOpen@@ -645,7 +637,7 @@ handler isfc osfc = do -- sendData client stream (HTTP2.setEndStream) message upload message (HTTP2.setEndHeader . HTTP2.setEndStream) client (_outgoingFlowControl client) stream osfc- let pph hStreamId hStream hHeaders hIfc hOfc =+ let pph _hStreamId _hStream hHeaders _hIfc _hOfc = lift $ print hHeaders response <- waitStream stream isfc pph let (errOrHeaders, frameResponses, _) = response@@ -666,6 +658,9 @@ "429" -> decodeReason ApnMessageResultTemporaryError body "500" -> decodeReason ApnMessageResultTemporaryError body "503" -> decodeReason ApnMessageResultTemporaryError body+ unknown ->+ ApnMessageResultFatalError $+ ApnFatalErrorOther (T.pack $ "unhandled status: " ++ show unknown) in StreamDefinition init handler case res of Left _ -> return ApnMessageResultBackoff -- Too much concurrency