diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -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 ======= diff --git a/push-notify-apn.cabal b/push-notify-apn.cabal --- a/push-notify-apn.cabal +++ b/push-notify-apn.cabal @@ -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 diff --git a/src/Network/PushNotify/APN.hs b/src/Network/PushNotify/APN.hs --- a/src/Network/PushNotify/APN.hs +++ b/src/Network/PushNotify/APN.hs @@ -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 } diff --git a/test/Network/PushNotify/APNSpec.hs b/test/Network/PushNotify/APNSpec.hs --- a/test/Network/PushNotify/APNSpec.hs +++ b/test/Network/PushNotify/APNSpec.hs @@ -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" $