apns-http2-0.1.1.0: example/Main.hs

{-# 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 <host> <port> <cert path> <key path> <device token> <topic>"

  (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