packages feed

push-notify-apn 0.1.0.3 → 0.1.0.4

raw patch · 5 files changed

+121/−38 lines, 5 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

+ Network.PushNotify.APN: closeSession :: ApnSession -> IO ()
+ Network.PushNotify.APN: isOpen :: ApnSession -> IO Bool

Files

README.md view
@@ -33,6 +33,17 @@ The -s flag means "sandbox", i.e., for apps that are deployed in a development environment. +You can also use an interactive mode, where messages are read from+stdin in this format:++    token:sound:title:message+    +To use, invoke like this:++    stack exec -- sendapn -k ~/greaselapn.key -c ~/greaselapn.crt -a /etc/ssl/cert.pem -b org.hcesperer.greasel -s -i+    +Do remove the -s flag when using the production instead of the sandbox environment.+ # credentials  apn.crt and apn.key are the certificate and private key of your
app/Main.hs view
@@ -3,23 +3,26 @@  import Control.Concurrent import Control.Monad+import Data.Maybe import Data.Semigroup ((<>)) import Options.Applicative  import qualified Data.ByteString.Char8 as B8 import qualified Data.Text as T+import qualified Data.Text.IO as TI  import Network.PushNotify.APN   data ApnOptions = ApnOptions-  { certpath :: !String-  , keypath  :: !String-  , capath   :: !String-  , topic    :: !String-  , tokens   :: !([String])-  , sandbox  :: !Bool-  , text     :: !String }+  { certpath    :: !String+  , keypath     :: !String+  , capath      :: !String+  , topic       :: !String+  , tokens      :: !([String])+  , sandbox     :: !Bool+  , interactive :: !Bool+  , text        :: !(Maybe String) }  p :: Parser ApnOptions p = ApnOptions@@ -47,10 +50,14 @@           ( long "sandbox"          <> short 's'          <> help "Whether to use the sandbox (non-production deployments)" )-      <*> strOption+      <*> switch+          ( long "interactive"+         <> short 'i'+         <> help "Run an interactive mode; each line must have this format: token:message " )+      <*> optional (strOption           ( short 'm'          <> metavar "MESSAGE"-         <> help "Message to send to the device" )+         <> help "Message to send to the device" ))         main :: IO ()@@ -63,9 +70,33 @@  send :: ApnOptions -> IO () send o = do-    session <- newSession (keypath o) (certpath o) (capath o) (sandbox o) 10 (B8.pack $ topic o)-    let payload  = alertMessage "push-notify-apn" (T.pack $ text o)-        message  = newMessage payload-    forM_ (tokens o) $ \token ->-        let apntoken = hexEncodedToken . T.pack $ token-        in sendMessage session apntoken message >>= print+    let mkSession = newSession (keypath o) (certpath o) (capath o) (sandbox o) 10 (B8.pack $ topic o)+    session <- mkSession+    if interactive o+    then+        let loop sess = do+                TI.putStrLn "Message in the form token:sound:title:message please"+                line <- TI.getLine+                let parts = T.splitOn ":" line+                if length parts >= 4+                then+                    let token   = hexEncodedToken $ head parts+                        text    = T.intercalate ":" (drop 3 parts)+                        title   = parts !! 2+                        sound   = parts !! 1+                        payload = setSound sound . alertMessage title $ text+                        message = newMessage payload+                    in (sendMessage sess token message >>= TI.putStrLn . T.pack . show) >> loop sess+                else case line of+                    "close" -> closeSession sess >> loop sess+                    "reset" -> mkSession >>= loop+                    "quit"  -> return ()+                    _ -> TI.putStrLn "Erroneous format" >> loop sess+        in loop session+    else do+        when (isNothing $ text o) $ error "You need to specify a message with -m"+        let payload  = alertMessage "push-notify-apn" (T.pack $ fromJust $ text o)+            message  = newMessage payload+        forM_ (tokens o) $ \token ->+            let apntoken = hexEncodedToken . T.pack $ token+            in sendMessage session apntoken message >>= print
changelog.md view
@@ -1,3 +1,12 @@+0.1.0.4+=======++- Add an interactive/scriptable mode where messages are read from stdin+- Re-structure exports to improve readability of the documentation+- Close connections in addition to sending http2 gtfo when idle time exceeded (needs http2-client-0.3.0.2)+- Add a closeSession method+- Close sessions when they are garbage collected+ 0.1.0.3 ======= 
push-notify-apn.cabal view
@@ -1,5 +1,5 @@ name:                push-notify-apn-version:             0.1.0.3+version:             0.1.0.4 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
src/Network/PushNotify/APN.hs view
@@ -11,30 +11,32 @@ {-# LANGUAGE DeriveGeneric #-}  module Network.PushNotify.APN-    ( ApnSession-    , JsonAps-    , JsonApsAlert-    , JsonApsMessage-    , ApnMessageResult(..)-    , ApnToken+    ( newSession+    , newMessage+    , newMessageWithCustomPayload+    , hexEncodedToken+    , rawToken     , sendMessage     , sendSilentMessage-    , newSession     , sendRawMessage-    , emptyMessage-    , setSound-    , clearSound-    , setCategory-    , clearCategory-    , setBadge-    , clearBadge     , alertMessage+    , emptyMessage     , setAlertMessage+    , setBadge+    , setCategory+    , setSound     , clearAlertMessage-    , newMessage-    , newMessageWithCustomPayload-    , hexEncodedToken-    , rawToken+    , clearBadge+    , clearCategory+    , clearSound+    , closeSession+    , isOpen+    , ApnSession+    , JsonAps+    , JsonApsAlert+    , JsonApsMessage+    , ApnMessageResult(..)+    , ApnToken     ) where  import Control.Concurrent@@ -58,6 +60,7 @@ import Network.HTTP2.Client.Helpers import Network.TLS hiding (sendData) import Network.TLS.Extra.Cipher+import System.Mem.Weak import System.Random  import qualified Data.ByteString as S@@ -75,7 +78,8 @@ data ApnSession = ApnSession     { apnSessionPool                 :: !(IORef [ApnConnection])     , apnSessionConnectionInfo       :: !ApnConnectionInfo-    , apnSessionConnectionManager    :: !ThreadId }+    , apnSessionConnectionManager    :: !ThreadId+    , apnSessionOpen                 :: !(IORef Bool)}  -- | Information about an APN connection data ApnConnectionInfo = ApnConnectionInfo@@ -288,10 +292,34 @@         connInfo = ApnConnectionInfo certPath certKey caPath hostname maxparallel topic     connections <- newIORef []     connectionManager <- forkIO $ manage 1800 connections-    return $ ApnSession connections connInfo connectionManager+    isOpen <- newIORef True+    let session = ApnSession connections connInfo connectionManager isOpen+    addFinalizer session $+        closeSession session+    return session +-- | Manually close a session. The session must not be used anymore+-- after it has been closed. Calling this function will close+-- the worker thread, and all open connections to the APN service+-- that belong to the given session. Note that sessions will be closed+-- autotically when they are garbage collected, so it is not necessary+-- to call this function.+closeSession :: ApnSession -> IO ()+closeSession s = do+    isOpen <- atomicModifyIORef' (apnSessionOpen s) (\a -> (False, a))+    when (not isOpen) $ error "Session is already closed"+    let ioref = apnSessionPool s+    openConnections <- atomicModifyIORef' ioref (\conns -> ([], conns))+    mapM_ closeApnConnection openConnections++-- | Check whether a session is open or has been closed+-- by a call to closeSession+isOpen :: ApnSession -> IO Bool+isOpen = readIORef . apnSessionOpen+ getConnection :: ApnSession -> IO ApnConnection getConnection s = do+    ensureOpen s     let pool = apnSessionPool s         ci = apnSessionConnectionInfo s     connections <- readIORef pool@@ -326,7 +354,6 @@  newConnection :: ApnConnectionInfo -> IO ApnConnection newConnection aci = do-    putStrLn "Starting new connection..."     Just castore <- readCertificateStore $ aciCaPath aci     Right credential <- credentialLoadX509 (aciCertPath aci) (aciCertKey aci)     let credentials = Credentials [credential]@@ -358,7 +385,6 @@     client <- newHttp2Client (T.unpack hostname) 443 4096 4096 clip conf     flowWorker <- forkIO $ forever $ do         updated <- _updateWindow $ _incomingFlowControl client-        when updated $ putStrLn "sending flow-control update"         threadDelay 1000000  --    let largestWindowSize = HTTP2.maxWindowSize - HTTP2.defaultInitialWindowSize@@ -381,6 +407,7 @@     let flowWorker = apnConnectionFlowControlWorker connection     killThread flowWorker     _gtfo (apnConnectionConnection connection) HTTP2.NoError ""+    _close (apnConnectionConnection connection)   -- | Send a raw payload as a push notification message (advanced)@@ -430,6 +457,11 @@     case res of         Left tmc   -> return ApnMessageResultTemporaryError -- TODO: Spawn new connection depending on poolsize         Right res1 -> return res1++ensureOpen :: ApnSession -> IO ()+ensureOpen s = do+    open <- isOpen s+    when (not open) $ error "Session is closed"  -- | Send a push notification message. sendApnRaw