{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Main where import Control.Concurrent (threadDelay) import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar) import Data.Aeson (encode) import Data.Aeson.QQ (aesonQQ) import qualified Data.ByteString as BS import qualified Data.ByteString.Base16 as Base16 import qualified Data.ByteString.Char8 as BSC8 import qualified Data.ByteString.Lazy as BL import Data.Foldable (for_) import Data.Monoid ((<>)) import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Time.Clock (addUTCTime, getCurrentTime) import Network.Apns import Network.TLS (credentialLoadX509Chain) import System.Environment (getArgs) import System.X509 (getSystemCertificateStore) import Text.Read (readMaybe) main :: IO () main = do (host, port, certPath, keyPath, deviceToken, topic) <- getArgs >>= \ case [h, readMaybe -> Just p, cp, kp, Base16.decode . BSC8.pack -> (dt, dt'), T.pack -> t] | BS.null dt' -> pure (h, p, cp, kp, dt, t) | otherwise -> fail "invalid device token" _ -> fail "usage: apns-http2-example " (clientCert, clientKey) <- either fail pure =<< credentialLoadX509Chain certPath [] keyPath terminationMv <- newEmptyMVar systemCAStore <- getSystemCertificateStore let params = ApnsConnectionParams { _apnsConnectionParams_hostName = host , _apnsConnectionParams_portNumber = port , _apnsConnectionParams_clientCertificateChain = clientCert , _apnsConnectionParams_clientCertificateKey = clientKey , _apnsConnectionParams_serverCertificateStore = Just systemCAStore , _apnsConnectionParams_onDebugLog = TIO.putStrLn . ("Network.Apns debug: " <>) , _apnsConnectionParams_onServerCertificate = Nothing -- Uncomment following line and comment previous one to disable server cert verification -- , _apnsConnectionParams_onServerCertificate = Just $ \ _ _ _ _ -> pure [] , _apnsConnectionParams_onTermination = putMVar terminationMv , _apnsConnectionParams_readQueueSize = 10 , _apnsConnectionParams_writeQueueSize = 10 , _apnsConnectionParams_pushQueueSize = 10 } connectApns params >>= \ case Left connectError -> putStrLn $ "Failed to connect: " <> show connectError Right connection -> do for_ [1..(100 :: Int)] $ \ _ -> do now <- getCurrentTime let _apnsPushData_deviceToken = deviceToken _apnsPushData_expiration = addUTCTime (86400*2) now _apnsPushData_priority = Nothing _apnsPushData_topic = topic _apnsPushData_collapseId = Nothing _apnsPushData_payload = BL.toStrict $ encode [aesonQQ| { "aps": { "alert": { "title": "Hello, APNs!", "body": "If you're reading this you're too close to a working integration" }, "badge": 1 }, "additionalStuff": "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX", "additionalStuff5": "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" } |] _apnsConnection_submitPush connection $ ApnsPush (ApnsPushData {..}) $ \ res -> do putStrLn . ("push result: " <>) . show $ res threadDelay 2000000 putStrLn "closing connection" _apnsConnection_close connection terminationReason <- takeMVar terminationMv putStrLn . ("Connection terminated: " <>) . show $ terminationReason