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 +11/−0
- app/Main.hs +46/−15
- changelog.md +9/−0
- push-notify-apn.cabal +1/−1
- src/Network/PushNotify/APN.hs +54/−22
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