{-# LANGUAGE OverloadedStrings #-}
module Network.PushNotification.IOS where
import Data.Binary.Put
import Data.Convertible (convert)
import GHC.Word (Word32, Word16)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import Data.Time.Clock.POSIX (getPOSIXTime)
import Network.BSD (getHostByName, hostAddress, getProtocolNumber)
import Network.Socket
import OpenSSL
import OpenSSL.Session as SSL
data APNSConfig = APNSConfig
{ _APNSConfig_server :: String
, _APNSConfig_key :: FilePath
, _APNSConfig_certificate :: FilePath
}
deriving (Show, Read, Eq, Ord)
gatewayLive :: String
gatewayLive = "gateway.push.apple.com"
gatewayTest :: String
gatewayTest = "gateway.sandbox.push.apple.com"
feedbackLive :: String
feedbackLive = "feedback.push.apple.com"
feedbackTest :: String
feedbackTest = "feedback.sandbox.push.apple.com"
data ApplePushMessage = ApplePushMessage
{ _applePushMessage_deviceToken :: B.ByteString
, _applePushMessage_payload :: BL.ByteString
, _applePushMessage_expiry :: Word32
}
checkFailLive :: FilePath -> FilePath -> IO [B.ByteString]
checkFailLive = checkFail feedbackLive
checkFailTest :: FilePath -> FilePath -> IO [B.ByteString]
checkFailTest = checkFail feedbackTest
checkFail :: String -> FilePath -> FilePath -> IO [B.ByteString]
checkFail server keyfile certfile = withOpenSSL $ do
ssl <- context
contextSetPrivateKeyFile ssl keyfile
contextSetCertificateFile ssl certfile
contextSetDefaultCiphers ssl
contextSetVerificationMode ssl SSL.VerifyNone
proto <- getProtocolNumber "tcp"
he <- getHostByName server
sock <- socket AF_INET Stream proto
Network.Socket.connect sock (SockAddrInet 2196 (hostAddress he))
sslsocket <- connection ssl sock
SSL.connect sslsocket
bs <- SSL.read sslsocket 7600000
print $ B.length bs
SSL.shutdown sslsocket Unidirectional
return $ splitBS bs
withAPNSSocket :: APNSConfig -> (SSL -> IO ()) -> IO ()
withAPNSSocket (APNSConfig server keyfile certfile) f = withOpenSSL $ do
ssl <- context
contextSetPrivateKeyFile ssl keyfile
contextSetCertificateFile ssl certfile
contextSetDefaultCiphers ssl
contextSetVerificationMode ssl SSL.VerifyNone
proto <- (getProtocolNumber "tcp")
he <- getHostByName server
sock <- socket AF_INET Stream proto
Network.Socket.connect sock (SockAddrInet 2195 (hostAddress he))
sslsocket <- connection ssl sock
SSL.connect sslsocket
f sslsocket
SSL.shutdown sslsocket Unidirectional
sendApplePushMessage :: SSL -> ApplePushMessage -> IO ()
sendApplePushMessage sslsocket m =
let lpdu = runPut $ buildPDU m
pdu = B.concat $ BL.toChunks lpdu
in SSL.write sslsocket pdu
tokenLength :: Num a => a
tokenLength = 32
maxPayloadLength :: Num a => a
maxPayloadLength = 2048
buildPDU :: ApplePushMessage -> Put
buildPDU (ApplePushMessage token payload expiry)
| B.length token /= tokenLength = fail "Invalid token"
| BL.length payload >= maxPayloadLength = fail "Payload too large"
| otherwise = do
putWord8 1
putWord32be 1
putWord32be expiry
putWord16be ((convert $ B.length token) :: Word16)
putByteString token
putWord16be ((convert $ BL.length payload) :: Word16)
putLazyByteString payload
splitBS :: B.ByteString -> [B.ByteString]
splitBS xs =
let xs1 = B.drop 6 xs
token = B.take 32 xs1
nexst = B.drop 32 xs1
in if B.null token then [] else token : splitBS nexst
getExpiryTime :: IO Word32
getExpiryTime = do
pt <- getPOSIXTime
return ( (round pt + 60*60):: Word32)