Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update for http2-5.3 and upcoming tls #1

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion push-notify-apn.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -29,8 +29,9 @@ library
, bytestring
, containers
, data-default
, http2 >= 3.0 && <= 5.1
, http2 >= 3.0 && <= 5.4
, http2-client >= 0.10.0.2
, http-types >= 0.12.4
, lifted-base
, mtl
, random
Expand Down
19 changes: 10 additions & 9 deletions src/Network/PushNotify/APN.hs
Original file line number Diff line number Diff line change
Expand Up @@ -91,6 +91,7 @@ import qualified Data.Text.Encoding as TE

import qualified Network.HPACK as HTTP2
import qualified Network.HTTP2.Frame as HTTP2
import qualified Network.HTTP.Types as HTTP

-- | A session that manages connections to Apple's push notification service
data ApnSession = ApnSession
Expand Down Expand Up @@ -138,7 +139,7 @@ hexEncodedToken = ApnToken . B16.encode . B16.decodeLenient . TE.encodeUtf8
-- | Exceptional responses to a send request
data ApnException = ApnExceptionHTTP ErrorCode
| ApnExceptionJSON String
| ApnExceptionMissingHeader HTTP2.HeaderName
| ApnExceptionMissingHeader HTTP.HeaderName
| ApnExceptionUnexpectedResponse
| ApnExceptionConnectionClosed
| ApnExceptionSessionClosed
Expand Down Expand Up @@ -506,16 +507,16 @@ newConnection aci = do
clip <- case (aciUseJWT aci) of
True -> do
castore <- getSystemCertificateStore
let clip = ClientParams
let clip = (defaultParamsClient (T.unpack hostname) undefined)
{ 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 () }
, clientDebug=def
{ debugSeed=Nothing, debugPrintSeed=const $ return (), debugVersionForced=Nothing, debugKeyLogger=const $ return () }
, clientSupported=def
{ supportedVersions=[ TLS12 ]
, supportedCiphers=ciphersuite_strong }
Expand All @@ -533,15 +534,15 @@ newConnection aci = do
shared = def { sharedCredentials = credentials
, sharedCAStore=castore }

clip = ClientParams
clip = (defaultParamsClient (T.unpack hostname) undefined)
{ 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 () }
, clientDebug=def
{ debugSeed=Nothing, debugPrintSeed=const $ return (), debugVersionForced=Nothing, debugKeyLogger=const $ return () }
, clientSupported=def
{ supportedVersions=[ TLS12 ]
, supportedCiphers=ciphersuite_strong }
Expand Down Expand Up @@ -710,10 +711,10 @@ sendApnRaw connection deviceToken mJwtBearerToken message = bracket_
eitherDecode body
>>= parseEither (\obj -> ctor <$> obj .: "reason")

getHeaderEx :: HTTP2.HeaderName -> [HTTP2.Header] -> HTTP2.HeaderValue
getHeaderEx :: HTTP.HeaderName -> [HTTP2.Header] -> ByteString
getHeaderEx name headers = fromMaybe (throw $ ApnExceptionMissingHeader name) (DL.lookup name headers)

defaultHeaders :: Text -> ByteString -> ByteString -> [(HTTP2.HeaderName, ByteString)]
defaultHeaders :: Text -> ByteString -> ByteString -> [(HTTP.HeaderName, ByteString)]
defaultHeaders hostname token topic = [ ( ":method", "POST" )
, ( ":scheme", "https" )
, ( ":authority", TE.encodeUtf8 hostname )
Expand Down