push-notify-apn 0.1.2.0 → 0.2.0.0

raw patch · 3 files changed

+55/−84 lines, 3 filesdep −lifted-basePVP ok

version bump matches the API change (PVP)

Dependencies removed: lifted-base

API changes (from Hackage documentation)

Files

• changelog.md +0/−7
• push-notify-apn.cabal +1/−2
• src/Network/PushNotify/APN.hs +54/−75

@@ -1,10 +1,3 @@--0.1.2.0-=======--- Threading bugfix-- Migrate to http2-client-0.9.0.0 and lts-14- 0.1.1.1 ======= 

@@ -1,5 +1,5 @@ name:                push-notify-apn-version:             0.1.2.0+version:             0.2.0.0 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@@ -31,7 +31,6 @@                      , data-default                      , http2                      , http2-client-                     , lifted-base                      , random                      , semigroups                      , text

@@ -10,7 +10,6 @@ {-# LANGUAGE DeriveGeneric     #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards   #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections     #-}  module Network.PushNotify.APN@@ -49,7 +48,7 @@  import           Control.Concurrent import           Control.Concurrent.QSem-import           Control.Exception.Lifted (Exception, bracket_, throw, throwIO)+import           Control.Exception import           Control.Monad import           Data.Aeson import           Data.Aeson.Types@@ -63,7 +62,6 @@ import           Data.Maybe import           Data.Semigroup                       ((<>)) import           Data.Text                            (Text)-import           Data.Time.Clock import           Data.Time.Clock.POSIX import           Data.Typeable                        (Typeable) import           Data.X509@@ -153,9 +151,11 @@                       | ApnMessageResultFatalError ApnFatalError                       | ApnMessageResultTemporaryError ApnTemporaryError                       | ApnMessageResultIOError IOError-                      | ApnMessageResultClientError ClientError     deriving (Eq, Show) +instance SpecifyError ApnMessageResult where+    isAnError = ApnMessageResultIOError+ -- | The specification of a push notification's message body data JsonApsAlert = JsonApsAlert     { jaaTitle :: !(Maybe Text)@@ -416,41 +416,31 @@ isOpen :: ApnSession -> IO Bool isOpen = readIORef . apnSessionOpen -withConnection :: ApnSession -> (ApnConnection -> ClientIO a) -> ClientIO a+withConnection :: ApnSession -> (ApnConnection -> IO a) -> IO a withConnection s action = do-    lift $ ensureOpen s+    ensureOpen s     let pool = apnSessionPool s-    mConn <- getExistingConnection pool-    case mConn of-        Nothing -> do-            conn <- newConnection s-            res <- action conn-            lift $ atomicModifyIORef' pool (\a -> (conn:a, ()))+    connections <- readIORef pool+    let len = length connections+    if len == 0+    then do+        conn <- newConnection s+        res <- action conn+        atomicModifyIORef' pool (\a -> (conn:a, ()))+        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 -> (removeNth num a, ()))+        isOpen <- readIORef (apnConnectionOpen conn)+        if isOpen+        then do+            res <- action conn1+            atomicModifyIORef' pool (\a -> (conn1:a, ()))             return res-        Just conn -> do-            currtime <- round <$> lift getPOSIXTime-            conn <- pure (conn { apnConnectionLastUsed=currtime })-            isOpen <- lift $ readIORef (apnConnectionOpen conn)-            if isOpen-            then do-                res <- action conn-                lift $ atomicModifyIORef' pool (\a -> (conn:a, ()))-                return res-            else withConnection s action-    where-        getExistingConnection :: (IORef [ApnConnection]) -> ClientIO (Maybe ApnConnection)-        getExistingConnection pool =-            do connections <- lift $ readIORef pool-               let len = length connections-               if len == 0-               then return Nothing-               else do-                   num <- lift $ randomRIO (0, len - 1)-                   lift $ atomicModifyIORef' pool $ \conns ->-                       case removeNthMay num conns of-                         Nothing -> (conns, Nothing)-                         Just (myConn, conns) -> (conns, Just myConn)-+        else withConnection s action  checkCertificates :: ApnConnectionInfo -> IO Bool checkCertificates aci = do@@ -458,13 +448,14 @@     credential <- credentialLoadX509 (aciCertPath aci) (aciCertKey aci)     return $ isJust castore && isRight credential -removeNthMay :: Int -> [a] -> Maybe (a, [a])-removeNthMay _ [] = Nothing-removeNthMay 0 (x:xs) = Just (x, xs)-removeNthMay n (x:xs) = fmap (second (x:)) (removeNthMay (n-1) xs)-    where-      second f (x, y) = (x, f y)+replaceNth n newVal (x:xs)+    | 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@@ -474,11 +465,11 @@     mapM_ closeApnConnection expiredOnes     threadDelay 60000000 -newConnection :: ApnSession -> ClientIO ApnConnection+newConnection :: ApnSession -> IO ApnConnection newConnection apnSession = do     let aci = apnSessionConnectionInfo apnSession-    Just castore <- lift $ readCertificateStore $ aciCaPath aci-    Right credential <- lift $ credentialLoadX509 (aciCertPath aci) (aciCertKey aci)+    Just castore <- readCertificateStore $ aciCaPath aci+    Right credential <- credentialLoadX509 (aciCertPath aci) (aciCertKey aci)     let credentials = Credentials [credential]         shared      = def { sharedCredentials = credentials                           , sharedCAStore=castore }@@ -506,29 +497,26 @@          hostname = aciHostname aci     httpFrameConnection <- newHttp2FrameConnection (T.unpack hostname) 443 (Just clip)-    isOpen <- lift $ newIORef True+    isOpen <- newIORef True     let handleGoAway rsgaf = do-            lift $ writeIORef isOpen False+            writeIORef isOpen False             return ()     client <- newHttp2Client httpFrameConnection 4096 4096 conf handleGoAway ignoreFallbackHandler     linkAsyncs client-    flowWorker <- lift $ forkIO $ forever $ do-        updated <- runClientIO $ _updateWindow $ _incomingFlowControl client+    flowWorker <- forkIO $ forever $ do+        updated <- _updateWindow $ _incomingFlowControl client         threadDelay 1000000 -    workersem <- lift $ newQSem maxConcurrentStreams-    currtime :: Int64 <- round <$> lift getPOSIXTime+    workersem <- newQSem maxConcurrentStreams+    currtime <- round <$> getPOSIXTime :: IO Int64     return $ ApnConnection client aci workersem currtime flowWorker isOpen   closeApnConnection :: ApnConnection -> IO ()-closeApnConnection connection =-    -- Ignoring ClientErrors in this place. We want to close our session, so we do not need to-    -- fail on this kind of errors.-    void $ runClientIO $ do-    lift $ writeIORef (apnConnectionOpen connection) False+closeApnConnection connection = do+    writeIORef (apnConnectionOpen connection) False     let flowWorker = apnConnectionFlowControlWorker connection-    lift $ killThread flowWorker+    killThread flowWorker     _gtfo (apnConnectionConnection connection) HTTP2.NoError ""     _close (apnConnectionConnection connection) @@ -543,7 +531,7 @@     -- ^ The message to send     -> IO ApnMessageResult     -- ^ The response from the APN server-sendRawMessage s token payload = catchErrors $+sendRawMessage s token payload = catchIOErrors $     withConnection s $ \c ->         sendApnRaw c token payload @@ -557,7 +545,7 @@     -- ^ The message to send     -> IO ApnMessageResult     -- ^ The response from the APN server-sendMessage s token payload = catchErrors $+sendMessage s token payload = catchIOErrors $     withConnection s $ \c ->         sendApnRaw c token message   where message = L.toStrict $ encode payload@@ -570,7 +558,7 @@     -- ^ Device to send the message to     -> IO ApnMessageResult     -- ^ The response from the APN server-sendSilentMessage s token = catchErrors $+sendSilentMessage s token = catchIOErrors $     withConnection s $ \c ->         sendApnRaw c token message   where message = "{\"aps\":{\"content-available\":1}}"@@ -588,10 +576,10 @@     -- ^ Device to send the message to     -> ByteString     -- ^ The message to send-    -> ClientIO ApnMessageResult+    -> IO ApnMessageResult sendApnRaw connection token message = bracket_-  (lift $ waitQSem (apnConnectionWorkerPool connection))-  (lift $ signalQSem (apnConnectionWorkerPool connection)) $ do+  (waitQSem (apnConnectionWorkerPool connection))+  (signalQSem (apnConnectionWorkerPool connection)) $ do     let requestHeaders = [ ( ":method", "POST" )                   , ( ":scheme", "https" )                   , ( ":authority", TE.encodeUtf8 hostname )@@ -609,7 +597,7 @@                 -- sendData client stream (HTTP2.setEndStream) message                 upload message (HTTP2.setEndHeader . HTTP2.setEndStream) client (_outgoingFlowControl client) stream osfc                 let pph hStreamId hStream hHeaders hIfc hOfc =-                        lift $ print hHeaders+                        print hHeaders                 response <- waitStream stream isfc pph                 let (errOrHeaders, frameResponses, _) = response                 case errOrHeaders of@@ -644,17 +632,8 @@         getHeaderEx :: HTTP2.HeaderName -> [HTTP2.Header] -> HTTP2.HeaderValue         getHeaderEx name headers = fromMaybe (throw $ ApnExceptionMissingHeader name) (DL.lookup name headers) --catchErrors :: ClientIO ApnMessageResult -> IO ApnMessageResult-catchErrors = catchIOErrors . catchClientErrors-    where-        catchIOErrors :: IO ApnMessageResult -> IO ApnMessageResult-        catchIOErrors = flip catchIOError (return . ApnMessageResultIOError)--        catchClientErrors :: ClientIO ApnMessageResult -> IO ApnMessageResult-        catchClientErrors act =-            either ApnMessageResultClientError id <$> runClientIO act-+catchIOErrors :: SpecifyError a => IO a -> IO a+catchIOErrors = flip catchIOError (return . isAnError)  -- The type of permanent error indicated by APNS -- See https://apple.co/2RDCdWC table 8-6 for the meaning of each value.