push-notify-apn 0.2.0.2 → 0.3.0.0
raw patch · 6 files changed
+188/−98 lines, 6 filesdep +x509-system
Dependencies added: x509-system
Files
- README.md +19/−14
- app/Main.hs +17/−12
- changelog.md +7/−0
- push-notify-apn.cabal +2/−1
- src/Network/PushNotify/APN.hs +140/−65
- test/Network/PushNotify/APNSpec.hs +3/−6
README.md view
@@ -6,21 +6,23 @@ without the need to keep open a long lived TCP connection per app, dramatically reducing the power consumption in standby mode. -The library is still in an experimental state. Bug and success reports-as well as feature and pull requests are very welcome.+The library is still in an experimental state but apparently is used by+a few people and seems to be working. Bug and success reports+as well as feature and pull requests are very welcome! Sending a message is as simple as: - 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+ let sandbox = True -- Development environment+ maxParallel = 10 -- Number of parallel connections to+ -- the APN Servers+ useJwt = False -- No message bearer Token+ session <- newSession (Just "my.key") (Just "my.crt")+ (Just "/etc/ssl/ca_certificates.txt") useJwt sandbox maxParallel "my.bundle.id" let payload = alertMessage "Title" "Hello From Haskell" message = newMessage payload token = base16EncodedToken "the-token"- success <- sendMessage session token payload+ success <- sendMessage session token None payload print success # command line utility@@ -41,18 +43,21 @@ 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+ stack exec -- sendapn -k ~/your.key -c ~/your.crt -a /etc/ssl/cert.pem -b your.application.identifier -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+your.crt and your.key are the certificate and private key of your APN certificate from apple. To extract them from a .p12 file,-use openssl:+you can use openssl: - openssl pkcs12 -in mycredentials.p12 -out apn.crt -nokeys- openssl pkcs12 -in mycredentials.p12 -nodes -out apn.key -nocerts+ openssl pkcs12 -in mycredentials.p12 -out your.crt -nokeys+ openssl pkcs12 -in mycredentials.p12 -nodes -out your.key -nocerts -ca-certificates.crt is a truststore that contains the root certificates+/etc/ssl/cert.pem is a truststore that contains the CA certificates that are used to verify the apn server's server certificates.+You can create your own truststore that contains only the+CAs you are sure are authorized to sign the push notification servers'+certificates.
app/Main.hs view
@@ -15,10 +15,11 @@ data ApnOptions = ApnOptions- { certpath :: !String- , keypath :: !String- , capath :: !String+ { certpath :: !(Maybe String)+ , keypath :: !(Maybe String)+ , capath :: !(Maybe String) , topic :: !String+ , jwt :: !(Maybe B8.ByteString) , tokens :: !([String]) , sandbox :: !Bool , interactive :: !Bool@@ -26,22 +27,26 @@ p :: Parser ApnOptions p = ApnOptions- <$> strOption+ <$> (optional $ strOption ( short 'c' <> metavar "CERTIFICATE"- <> help "Path to the certificate" )- <*> strOption+ <> help "Path to the certificate" ))+ <*> (optional $ strOption ( short 'k' <> metavar "PRIVATEKEY"- <> help "Path to the certificate's private key" )- <*> strOption+ <> help "Path to the certificate's private key" ))+ <*> (optional $ strOption ( short 'a' <> metavar "CATRUSTSTORE"- <> help "Path to the CA truststore" )+ <> help "Path to the CA truststore" )) <*> strOption ( short 'b' <> metavar "BUNDLEID" <> help "Bundle ID of the app to send the notification to. Must correspond to the certificate." )+ <*> (optional $ strOption+ ( short 'j'+ <> metavar "JWT"+ <> help "JWT Bearer token" )) <*> many ( strOption ( short 't' <> metavar "TOKEN"@@ -71,7 +76,7 @@ send :: ApnOptions -> IO () send o = do let mkSession =- newSession (keypath o) (certpath o) (capath o) (sandbox o) 10 1 (B8.pack $ topic o)+ newSession (keypath o) (certpath o) (capath o) (if isJust (jwt o) then True else False) (sandbox o) 10 1 (B8.pack $ topic o) session <- mkSession if interactive o then@@ -87,7 +92,7 @@ sound = parts !! 1 payload = setSound sound . alertMessage title $ text message = newMessage payload- in (sendMessage sess token message >>= TI.putStrLn . T.pack . show) >> loop sess+ in (sendMessage sess token (jwt o) message >>= TI.putStrLn . T.pack . show) >> loop sess else case line of "close" -> closeSession sess >> loop sess "reset" -> mkSession >>= loop@@ -100,4 +105,4 @@ message = newMessage payload forM_ (tokens o) $ \token -> let apntoken = hexEncodedToken . T.pack $ token- in sendMessage session apntoken message >>= print+ in sendMessage session apntoken (jwt o) message >>= print
changelog.md view
@@ -1,3 +1,10 @@+0.3.0.0+=======++- Add support for JWT authentication+- Allow arbitrary user specific content to be passed to the push API+- Stability improvements+ 0.2.0.2 =======
push-notify-apn.cabal view
@@ -1,5 +1,5 @@ name: push-notify-apn-version: 0.2.0.2+version: 0.3.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@@ -41,6 +41,7 @@ , tls , x509 , x509-store+ , x509-system default-language: Haskell2010
src/Network/PushNotify/APN.hs view
@@ -8,11 +8,13 @@ -- -- Send push notifications using Apple's HTTP2 APN API {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-}+{-# LANGUAGE NumericUnderscores #-} module Network.PushNotify.APN ( newSession@@ -45,7 +47,7 @@ , ApnMessageResult(..) , ApnFatalError(..) , ApnTemporaryError(..)- , ApnToken+ , ApnToken(..) ) where import Control.Concurrent@@ -72,7 +74,7 @@ import Data.X509 import Data.X509.CertificateStore import GHC.Generics-import Network.HTTP2 (ErrorCodeId,+import Network.HTTP2.Frame (ErrorCodeId, toErrorCodeId) import "http2-client" Network.HTTP2.Client import "http2-client" Network.HTTP2.Client.FrameConnection@@ -82,6 +84,8 @@ import System.IO.Error import System.Mem.Weak import System.Random+import System.Timeout (timeout)+import System.X509 import qualified Data.ByteString as S import qualified Data.ByteString.Base16 as B16@@ -92,7 +96,7 @@ import qualified Data.Text.Encoding as TE import qualified Network.HPACK as HTTP2-import qualified Network.HTTP2 as HTTP2+import qualified Network.HTTP2.Frame as HTTP2 -- | A session that manages connections to Apple's push notification service data ApnSession = ApnSession@@ -102,12 +106,13 @@ -- | Information about an APN connection data ApnConnectionInfo = ApnConnectionInfo- { aciCertPath :: !FilePath- , aciCertKey :: !FilePath- , aciCaPath :: !FilePath+ { aciCertPath :: !(Maybe FilePath)+ , aciCertKey :: !(Maybe FilePath)+ , aciCaPath :: !(Maybe FilePath) , aciHostname :: !Text , aciMaxConcurrentStreams :: !Int- , aciTopic :: !ByteString }+ , aciTopic :: !ByteString+ , aciUseJWT :: !Bool } -- | A connection to an APN API server data ApnConnection = ApnConnection@@ -171,6 +176,12 @@ , omitNothingFields = True } +instance FromJSON JsonApsAlert where+ parseJSON = genericParseJSON defaultOptions+ { fieldLabelModifier = drop 3 . map toLower+ , omitNothingFields = True+ }+ -- | Push notification message's content data JsonApsMessage -- | Push notification message's content@@ -303,6 +314,10 @@ toJSON = genericToJSON defaultOptions { fieldLabelModifier = drop 3 . map toLower } +instance FromJSON JsonApsMessage where+ parseJSON = genericParseJSON defaultOptions+ { fieldLabelModifier = drop 3 . map toLower }+ -- | A push notification message data JsonAps -- | A push notification message@@ -315,10 +330,16 @@ -- ^ Additional fields to be used by the receiving app } deriving (Generic, Show) +instance FromJSON JsonAps where+ parseJSON = withObject "JsonAps" $ \o ->+ JsonAps <$> o .: "aps"+ <*> o .:? "appspecificcontent"+ <*> o .: "data"+ instance ToJSON JsonAps where toJSON JsonAps{..} = object (staticFields <> dynamicFields) where- dynamicFields = M.toList jaSupplementalFields+ dynamicFields = [ "data" .= jaSupplementalFields ] staticFields = [ "aps" .= jaAps , "appspecificcontent" .= jaAppSpecificContent ]@@ -368,13 +389,15 @@ -- pool of workers that create HTTP2 streams to send individual push -- notifications. newSession- :: FilePath+ :: Maybe FilePath -- ^ Path to the client certificate key- -> FilePath+ -> Maybe FilePath -- ^ Path to the client certificate- -> FilePath+ -> Maybe FilePath -- ^ Path to the CA -> Bool+ -- ^ Whether to use JWT as a bearer token+ -> Bool -- ^ True if the apn development servers should be used, False to use the production servers -> Int -- ^ How many messages will be sent in parallel? This corresponds to the number of http2 streams open in parallel; 100 seems to be a default value.@@ -384,17 +407,19 @@ -- ^ Topic (bundle name of the app) -> IO ApnSession -- ^ The newly created session-newSession certKey certPath caPath dev maxparallel maxConnectionCount topic = do+newSession certKey certPath caPath useJwt dev maxparallel maxConnectionCount topic = do let hostname = if dev- then "api.development.push.apple.com"+ then "api.sandbox.push.apple.com" else "api.push.apple.com"- connInfo = ApnConnectionInfo certPath certKey caPath hostname maxparallel topic- certsOk <- checkCertificates connInfo- unless certsOk $ error "Unable to load certificates and/or the private key"+ connInfo = ApnConnectionInfo certPath certKey caPath hostname maxparallel topic useJwt+ unless useJwt $ do+ certsOk <- checkCertificates connInfo+ unless certsOk $ error "Unable to load certificates and/or the private key"+ isOpen <- newIORef True let connectionUnusedTimeout :: NominalDiffTime- connectionUnusedTimeout = 600+ connectionUnusedTimeout = 300 pool <- createPool (newConnection connInfo) closeApnConnection 1 connectionUnusedTimeout maxConnectionCount@@ -403,8 +428,6 @@ { apnSessionPool = pool , apnSessionOpen = isOpen }- addFinalizer session $- closeSession session return session -- | Manually close a session. The session must not be used anymore@@ -424,55 +447,93 @@ isOpen :: ApnSession -> IO Bool isOpen = readIORef . apnSessionOpen +timeoutSeconds :: Int+timeoutSeconds = 300 * 1_000_000 -- 300 seconds to microseconds+ withConnection :: ApnSession -> (ApnConnection -> ClientIO a) -> ClientIO a withConnection s action = do lift $ ensureOpen s ExceptT . try $ withResource (apnSessionPool s) $ \conn -> do- res <- runClientIO (action conn)- case res of- Left clientError ->- -- When there is a clientError, we think that the connetion is broken.- -- Throwing an exception is the way we inform the resource pool.- throw clientError- Right res -> return res+ mRes <- timeout timeoutSeconds (runClientIO (action conn))+ case mRes of+ Nothing -> do+ throw EarlyEndOfStream+ Just eRes -> do+ case eRes of+ Left clientError ->+ -- When there is a clientError, we think that the connetion is broken.+ -- Throwing an exception is the way we inform the resource pool.+ throw clientError+ Right res -> return res checkCertificates :: ApnConnectionInfo -> IO Bool checkCertificates aci = do- castore <- readCertificateStore $ aciCaPath aci- credential <- credentialLoadX509 (aciCertPath aci) (aciCertKey aci)- return $ isJust castore && isRight credential+ case (aciUseJWT aci) of+ True -> pure False+ False -> do+ castore <- maybe (pure Nothing) readCertificateStore $ aciCaPath aci+ credential <- case (aciCertPath aci, aciCertKey aci) of+ (Just cert, Just key) -> credentialLoadX509 cert key+ (Nothing, Nothing) -> pure $ Left "no creds"+ return $ isJust castore && isRight credential newConnection :: ApnConnectionInfo -> IO ApnConnection newConnection aci = do- Just castore <- readCertificateStore $ aciCaPath aci- Right credential <- credentialLoadX509 (aciCertPath aci) (aciCertKey aci)- let credentials = Credentials [credential]- shared = def { sharedCredentials = credentials- , sharedCAStore=castore }- maxConcurrentStreams = aciMaxConcurrentStreams aci- clip = ClientParams- { clientUseMaxFragmentLength=Nothing- , clientServerIdentification=(T.unpack hostname, undefined)- , clientUseServerNameIndication=True- , clientWantSessionResume=Nothing- , clientShared=shared- , clientHooks=def- { onCertificateRequest=const . return . Just $ credential }- , clientDebug=DebugParams { debugSeed=Nothing, debugPrintSeed=const $ return () }- , clientSupported=def- { supportedVersions=[ TLS12 ]- , supportedCiphers=ciphersuite_strong }- }-+ let maxConcurrentStreams = aciMaxConcurrentStreams aci conf = [ (HTTP2.SettingsMaxFrameSize, 16384) , (HTTP2.SettingsMaxConcurrentStreams, maxConcurrentStreams) , (HTTP2.SettingsMaxHeaderBlockSize, 4096) , (HTTP2.SettingsInitialWindowSize, 65536) , (HTTP2.SettingsEnablePush, 1) ]- hostname = aciHostname aci++ clip <- case (aciUseJWT aci) of+ True -> do+ castore <- getSystemCertificateStore+ let maxConcurrentStreams = aciMaxConcurrentStreams aci+ clip = ClientParams+ { clientUseMaxFragmentLength=Nothing+ , clientServerIdentification=(T.unpack hostname, undefined)+ , clientUseServerNameIndication=True+ , clientWantSessionResume=Nothing+ , clientShared=def+ { sharedCAStore=castore }+ , clientHooks=def+ { onCertificateRequest = const . return $ Nothing }+ , clientDebug=DebugParams { debugSeed=Nothing, debugPrintSeed=const $ return (), debugVersionForced=Nothing, debugKeyLogger=const $ return () }+ , clientSupported=def+ { supportedVersions=[ TLS12 ]+ , supportedCiphers=ciphersuite_strong }+ , clientEarlyData=Nothing+ }+ 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"+ let credentials = Credentials [credential]+ shared = def { sharedCredentials = credentials+ , sharedCAStore=castore }++ clip = ClientParams+ { clientUseMaxFragmentLength=Nothing+ , clientServerIdentification=(T.unpack hostname, undefined)+ , clientUseServerNameIndication=True+ , clientWantSessionResume=Nothing+ , clientShared=shared+ , clientHooks=def+ { onCertificateRequest=const . return . Just $ credential }+ , clientDebug=DebugParams { debugSeed=Nothing, debugPrintSeed=const $ return (), debugVersionForced=Nothing, debugKeyLogger=const $ return () }+ , clientSupported=def+ { supportedVersions=[ TLS12 ]+ , supportedCiphers=ciphersuite_strong }+ , clientEarlyData=Nothing+ }+ pure clip+ isOpen <- newIORef True let handleGoAway rsgaf = do lift $ writeIORef isOpen False@@ -509,13 +570,15 @@ -- ^ Session to use -> ApnToken -- ^ Device to send the message to+ -> Maybe ByteString+ -- ^ JWT Bearer Token -> ByteString -- ^ The message to send -> IO ApnMessageResult -- ^ The response from the APN server-sendRawMessage s token payload = catchErrors $+sendRawMessage s deviceToken mJwtToken payload = catchErrors $ withConnection s $ \c ->- sendApnRaw c token payload+ sendApnRaw c deviceToken mJwtToken payload -- | Send a push notification message. sendMessage@@ -523,13 +586,15 @@ -- ^ Session to use -> ApnToken -- ^ Device to send the message to+ -> Maybe ByteString+ -- ^ JWT Bearer Token -> JsonAps -- ^ The message to send -> IO ApnMessageResult -- ^ The response from the APN server-sendMessage s token payload = catchErrors $+sendMessage s token mJwt payload = catchErrors $ withConnection s $ \c ->- sendApnRaw c token message+ sendApnRaw c token mJwt message where message = L.toStrict $ encode payload -- | Send a silent push notification@@ -538,11 +603,13 @@ -- ^ Session to use -> ApnToken -- ^ Device to send the message to+ -> Maybe ByteString+ -- ^ JWT Bearer Token -> IO ApnMessageResult -- ^ The response from the APN server-sendSilentMessage s token = catchErrors $+sendSilentMessage s token mJwt = catchErrors $ withConnection s $ \c ->- sendApnRaw c token message+ sendApnRaw c token mJwt message where message = "{\"aps\":{\"content-available\":1}}" ensureOpen :: ApnSession -> IO ()@@ -556,22 +623,22 @@ -- ^ Connection to use -> ApnToken -- ^ Device to send the message to+ -> Maybe ByteString+ -- ^ JWT Bearer Token -> ByteString -- ^ The message to send -> ClientIO ApnMessageResult-sendApnRaw connection token message = bracket_+sendApnRaw connection deviceToken mJwtBearerToken message = bracket_ (lift $ waitQSem (apnConnectionWorkerPool connection)) (lift $ signalQSem (apnConnectionWorkerPool connection)) $ do- let requestHeaders = [ ( ":method", "POST" )- , ( ":scheme", "https" )- , ( ":authority", TE.encodeUtf8 hostname )- , ( ":path", "/3/device/" `S.append` token1 )- , ( "apns-topic", topic ) ]- aci = apnConnectionInfo connection+ let aci = apnConnectionInfo connection+ requestHeaders = maybe (defaultHeaders hostname token1 topic)+ (\bearerToken -> (defaultHeaders hostname token1 topic) <> [ ( "authorization", "bearer " <> bearerToken ) ])+ mJwtBearerToken hostname = aciHostname aci topic = aciTopic aci client = apnConnectionConnection connection- token1 = unApnToken token+ token1 = unApnToken deviceToken res <- _startStream client $ \stream -> let init = headers stream requestHeaders id@@ -586,6 +653,7 @@ Left err -> throwIO (ApnExceptionHTTP $ toErrorCodeId err) Right hdrs1 -> do let status = getHeaderEx ":status" hdrs1+ -- apns-id = getHeaderEx "apns-id" hdrs1 [Right body] = frameResponses return $ case status of@@ -614,7 +682,14 @@ getHeaderEx :: HTTP2.HeaderName -> [HTTP2.Header] -> HTTP2.HeaderValue getHeaderEx name headers = fromMaybe (throw $ ApnExceptionMissingHeader name) (DL.lookup name headers) + defaultHeaders :: Text -> ByteString -> ByteString -> [(HTTP2.HeaderName, ByteString)]+ defaultHeaders hostname token topic = [ ( ":method", "POST" )+ , ( ":scheme", "https" )+ , ( ":authority", TE.encodeUtf8 hostname )+ , ( ":path", "/3/device/" `S.append` token )+ , ( "apns-topic", topic ) ] + catchErrors :: ClientIO ApnMessageResult -> IO ApnMessageResult catchErrors = catchIOErrors . catchClientErrors where@@ -677,7 +752,7 @@ | ApnTemporaryErrorInternalServerError | ApnTemporaryErrorServiceUnavailable | ApnTemporaryErrorShutdown- deriving (Enum, Eq, Show, Generic)+ deriving (Enum, Eq, Show, Generic, ToJSON) instance FromJSON ApnTemporaryError where parseJSON = genericParseJSON defaultOptions { constructorTagModifier = drop 17 }
test/Network/PushNotify/APNSpec.hs view
@@ -35,7 +35,8 @@ it "encodes normally when there are no supplemental fields" $ toJSON (newMessage (alertMessage "hello" "world")) `shouldBe` object [ "aps" .= alertMessage "hello" "world",- "appspecificcontent" .= Null+ "appspecificcontent" .= Null,+ "data" .= object [] ] it "encodes supplemental fields" $ do@@ -44,10 +45,9 @@ & addSupplementalField "aaa" ("qux" :: String) toJSON msg `shouldBe` object [- "aaa" .= String "qux", "aps" .= alertMessage "hello" "world", "appspecificcontent" .= Null,- "foo" .= String "bar"+ "data" .= object ["aaa" .= String "qux", "foo" .= String "bar"] ] describe "ApnFatalError" $@@ -57,9 +57,6 @@ it "dumps unknown error types into a wildcard result" $ eitherDecode "\"BadcollapseId\"" `shouldBe` Right (ApnFatalErrorOther "BadcollapseId")-- it "errors on invalid JSON" $- eitherDecode "\"crap" `shouldBe` (Left "Error in $: not enough input" :: Either String ApnFatalError) describe "ApnTemporaryError" $ context "JSON decoder" $