push-notify-apn 0.1.0.5 → 0.1.0.7
raw patch · 4 files changed
+77/−38 lines, 4 filesdep ~http2-clientPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: http2-client
API changes (from Hackage documentation)
Files
- README.md +4/−3
- changelog.md +16/−0
- push-notify-apn.cabal +2/−2
- src/Network/PushNotify/APN.hs +55/−33
README.md view
@@ -11,11 +11,12 @@ Sending a message is as simple as: - let sandbox = True -- Development environment- timeout = 10 -- Minutes to keep the connection open+ let sandbox = True -- Development environment+ maxParallel = 10 -- Number of parallel connections to+ -- the APN Servers session <- newSession "my.key" "my.crt" "/etc/ssl/ca_certificates.txt" sandbox- timeout "my.bundle.id"+ maxParallel "my.bundle.id" let payload = alertMessage "Title" "Hello From Haskell" message = newMessage payload token = base16EncodedToken "the-token"
changelog.md view
@@ -1,3 +1,19 @@+0.1.0.7+=======++- Make compatible with latest http2-client-0.7.0.0++0.1.0.6+=======++- Use http2-client-0.5.0.0 or greater+- Detect http2 goaway frames and remove connections from the+ connection pool accordingly+- Detect connection errors when sending messages and remove+ connections from the pool when they happen+- Fix in the README: The parameter is not timeout, but+ parallelConnections+ 0.1.0.5 =======
push-notify-apn.cabal view
@@ -1,5 +1,5 @@ name: push-notify-apn-version: 0.1.0.5+version: 0.1.0.7 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@@ -30,7 +30,7 @@ , containers , data-default , http2- , http2-client == 0.3.0.2+ , http2-client >= 0.7.0.0 && < 0.8 , random , text , time
src/Network/PushNotify/APN.hs view
@@ -59,6 +59,7 @@ import Data.X509.CertificateStore import GHC.Generics import Network.HTTP2.Client+import Network.HTTP2.Client.FrameConnection import Network.HTTP2.Client.Helpers import Network.TLS hiding (sendData) import Network.TLS.Extra.Cipher@@ -99,7 +100,8 @@ , apnConnectionInfo :: !ApnConnectionInfo , apnConnectionWorkerPool :: !QSem , apnConnectionLastUsed :: !Int64- , apnConnectionFlowControlWorker :: !ThreadId }+ , apnConnectionFlowControlWorker :: !ThreadId+ , apnConnectionOpen :: !(IORef Bool)} -- | An APN token used to uniquely identify a device newtype ApnToken = ApnToken { unApnToken :: ByteString }@@ -315,9 +317,9 @@ else "api.push.apple.com" connInfo = ApnConnectionInfo certPath certKey caPath hostname maxparallel topic certsOk <- checkCertificates connInfo- when (not certsOk) $ error "Unable to load certificates and/or the private key"+ unless certsOk $ error "Unable to load certificates and/or the private key" connections <- newIORef []- connectionManager <- forkIO $ manage 1800 connections+ connectionManager <- forkIO $ manage 600 connections isOpen <- newIORef True let session = ApnSession connections connInfo connectionManager isOpen addFinalizer session $@@ -333,7 +335,7 @@ closeSession :: ApnSession -> IO () closeSession s = do isOpen <- atomicModifyIORef' (apnSessionOpen s) (\a -> (False, a))- when (not isOpen) $ error "Session is already closed"+ unless isOpen $ error "Session is already closed" killThread (apnSessionConnectionManager s) let ioref = apnSessionPool s openConnections <- atomicModifyIORef' ioref (\conns -> ([], conns))@@ -344,25 +346,31 @@ isOpen :: ApnSession -> IO Bool isOpen = readIORef . apnSessionOpen -getConnection :: ApnSession -> IO ApnConnection-getConnection s = do+withConnection :: ApnSession -> (ApnConnection -> IO a) -> IO a+withConnection s action = do ensureOpen s let pool = apnSessionPool s- ci = apnSessionConnectionInfo s connections <- readIORef pool let len = length connections if len == 0 then do- conn <- newConnection ci+ conn <- newConnection s+ res <- action conn atomicModifyIORef' pool (\a -> (conn:a, ()))- return conn+ return res else do num <- randomRIO (0, len - 1) currtime <- round <$> getPOSIXTime :: IO Int64 let conn = connections !! num conn1 = conn { apnConnectionLastUsed=currtime }- atomicModifyIORef' pool (\a -> (replaceNth num conn1 a, ()))- return conn1+ atomicModifyIORef' pool (\a -> (removeNth num a, ()))+ isOpen <- readIORef (apnConnectionOpen conn)+ if isOpen+ then do+ res <- action conn1+ atomicModifyIORef' pool (\a -> (conn1:a, ()))+ return res+ else withConnection s action checkCertificates :: ApnConnectionInfo -> IO Bool checkCertificates aci = do@@ -374,17 +382,22 @@ | n == 0 = newVal:xs | otherwise = x:replaceNth (n-1) newVal xs +removeNth n (x:xs)+ | n == 0 = xs+ | otherwise = x:removeNth (n-1) xs+ manage :: Int64 -> IORef [ApnConnection] -> IO () manage timeout ioref = forever $ do currtime <- round <$> getPOSIXTime :: IO Int64 let minTime = currtime - timeout expiredOnes <- atomicModifyIORef' ioref- (foldl ( \(a,b) i -> if apnConnectionLastUsed i < minTime then (a, (i:b) ) else ( (i:a) ,b)) ([],[]))+ (foldl ( \(a,b) i -> if apnConnectionLastUsed i < minTime then (a, i:b ) else ( i:a ,b)) ([],[])) mapM_ closeApnConnection expiredOnes threadDelay 60000000 -newConnection :: ApnConnectionInfo -> IO ApnConnection-newConnection aci = do+newConnection :: ApnSession -> IO ApnConnection+newConnection apnSession = do+ let aci = apnSessionConnectionInfo apnSession Just castore <- readCertificateStore $ aciCaPath aci Right credential <- credentialLoadX509 (aciCertPath aci) (aciCertKey aci) let credentials = Credentials [credential]@@ -413,18 +426,25 @@ ] hostname = aciHostname aci- client <- newHttp2Client (T.unpack hostname) 443 4096 4096 clip conf+ httpFrameConnection <- newHttp2FrameConnection (T.unpack hostname) 443 (Just clip)+ isOpen <- newIORef True+ let handleGoAway rsgaf = do+ writeIORef isOpen False+ return ()+ client <- newHttp2Client httpFrameConnection 4096 4096 conf handleGoAway ignoreFallbackHandler+ linkAsyncs client flowWorker <- forkIO $ forever $ do updated <- _updateWindow $ _incomingFlowControl client threadDelay 1000000 workersem <- newQSem maxConcurrentStreams currtime <- round <$> getPOSIXTime :: IO Int64- return $ ApnConnection client aci workersem currtime flowWorker+ return $ ApnConnection client aci workersem currtime flowWorker isOpen closeApnConnection :: ApnConnection -> IO () closeApnConnection connection = do+ writeIORef (apnConnectionOpen connection) False let flowWorker = apnConnectionFlowControlWorker connection killThread flowWorker _gtfo (apnConnectionConnection connection) HTTP2.NoError ""@@ -441,9 +461,9 @@ -- ^ The message to send -> IO ApnMessageResult -- ^ The response from the APN server-sendRawMessage s token payload = catchIOErrors $ do- c <- getConnection s- sendApnRaw c token payload+sendRawMessage s token payload = catchIOErrors $+ withConnection s $ \c ->+ sendApnRaw c token payload -- | Send a push notification message. sendMessage@@ -455,10 +475,10 @@ -- ^ The message to send -> IO ApnMessageResult -- ^ The response from the APN server-sendMessage s token payload = catchIOErrors $ do- c <- getConnection s- let message = L.toStrict $ encode payload- sendApnRaw c token message+sendMessage s token payload = catchIOErrors $+ withConnection s $ \c ->+ sendApnRaw c token message+ where message = L.toStrict $ encode payload -- | Send a silent push notification sendSilentMessage@@ -468,15 +488,15 @@ -- ^ Device to send the message to -> IO ApnMessageResult -- ^ The response from the APN server-sendSilentMessage s token = catchIOErrors $ do- c <- getConnection s- let message = "{\"aps\":{\"content-available\":1}}"- sendApnRaw c token message+sendSilentMessage s token = catchIOErrors $+ withConnection s $ \c ->+ sendApnRaw c token message+ where message = "{\"aps\":{\"content-available\":1}}" ensureOpen :: ApnSession -> IO () ensureOpen s = do open <- isOpen s- when (not open) $ error "Session is closed"+ unless open $ error "Session is closed" -- | Send a push notification message. sendApnRaw@@ -490,7 +510,7 @@ sendApnRaw connection token message = bracket_ (waitQSem (apnConnectionWorkerPool connection)) (signalQSem (apnConnectionWorkerPool connection)) $ do- let headers = [ ( ":method", "POST" )+ let requestHeaders = [ ( ":method", "POST" ) , ( ":scheme", "https" ) , ( ":authority", TE.encodeUtf8 hostname ) , ( ":path", "/3/device/" `S.append` token1 )@@ -502,12 +522,14 @@ token1 = unApnToken token res <- _startStream client $ \stream ->- let init = _headers stream headers id+ let init = headers stream requestHeaders id handler isfc osfc = do -- sendData client stream (HTTP2.setEndStream) message- upload message client (_outgoingFlowControl client) stream osfc- hdrs <- _waitHeaders stream- let (frameHeader, streamId, errOrHeaders) = hdrs+ upload message (HTTP2.setEndHeader . HTTP2.setEndStream) client (_outgoingFlowControl client) stream osfc+ let pph hStreamId hStream hHeaders hIfc hOfc =+ print hHeaders+ response <- waitStream stream isfc pph+ let (errOrHeaders, _, _) = response case errOrHeaders of Left err -> return ApnMessageResultTemporaryError Right hdrs1 -> do