{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module Network.Pusher (
Pusher(..)
, Credentials(..)
, Cluster(..)
, AppID
, AppKey
, AppSecret
, getPusher
, getPusherWithHost
, getPusherWithConnManager
, Channel(..)
, ChannelName
, ChannelType(..)
, renderChannel
, renderChannelPrefix
, parseChannel
, Event
, EventData
, SocketID
, Notification(..)
, Interest
, mkInterest
, WebhookURL
, WebhookLevel(..)
, APNSPayload(..)
, GCMPayload(..)
, FCMPayload(..)
, trigger
, channels
, channel
, users
, notify
, AuthString
, AuthSignature
, authenticatePresence
, authenticatePrivate
, PusherError(..)
, parseWebhookPayload
, WebhookEv(..)
, WebhookPayload(..)
, Webhooks(..)
, parseAppKeyHdr
, parseAuthSignatureHdr
, parseWebhooksBody
, verifyWebhooksBody
, parseWebhookPayloadWith
) where
import Control.Monad.IO.Class (MonadIO, liftIO)
import Control.Monad.Trans.Except (ExceptT(ExceptT), runExceptT)
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as BC
import Network.Pusher.Data
(APNSPayload(..), AppID, AppKey, AppSecret, Channel(..),
ChannelName, ChannelType(..), Cluster(..), Credentials(..), Event,
EventData, FCMPayload(..), GCMPayload(..), Interest,
Notification(..), Pusher(..), SocketID, WebhookLevel(..),
WebhookURL, getPusher, getPusherWithConnManager, getPusherWithHost,
mkInterest, parseChannel, renderChannel, renderChannelPrefix)
import Network.Pusher.Error (PusherError(..))
import qualified Network.Pusher.Internal as Pusher
import Network.Pusher.Internal.Auth
(AuthSignature, AuthString, authenticatePresence,
authenticatePrivate)
import qualified Network.Pusher.Internal.HTTP as HTTP
import Network.Pusher.Internal.Util (getTime)
import Network.Pusher.Protocol
(ChannelInfoQuery, ChannelsInfo, ChannelsInfoQuery,
FullChannelInfo, Users)
import Network.Pusher.Webhook
(WebhookEv(..), WebhookPayload(..), Webhooks(..), parseAppKeyHdr,
parseAuthSignatureHdr, parseWebhookPayloadWith, parseWebhooksBody,
verifyWebhooksBody)
trigger ::
MonadIO m
=> Pusher
-> [Channel]
-> Event
-> EventData
-> Maybe SocketID
-> m (Either PusherError ())
trigger pusher chans event dat socketId =
liftIO $
runExceptT $ do
(requestParams, requestBody) <-
ExceptT $
Pusher.mkTriggerRequest pusher chans event dat socketId <$> getTime
HTTP.post (pusherConnectionManager pusher) requestParams requestBody
channels ::
MonadIO m
=> Pusher
-> Maybe ChannelType
-> T.Text
-> ChannelsInfoQuery
-> m (Either PusherError ChannelsInfo)
channels pusher channelTypeFilter prefixFilter attributes =
liftIO $
runExceptT $ do
requestParams <-
liftIO $
Pusher.mkChannelsRequest pusher channelTypeFilter prefixFilter attributes <$>
getTime
HTTP.get (pusherConnectionManager pusher) requestParams
channel ::
MonadIO m
=> Pusher
-> Channel
-> ChannelInfoQuery
-> m (Either PusherError FullChannelInfo)
channel pusher chan attributes =
liftIO $
runExceptT $ do
requestParams <-
liftIO $ Pusher.mkChannelRequest pusher chan attributes <$> getTime
HTTP.get (pusherConnectionManager pusher) requestParams
users :: MonadIO m => Pusher -> Channel -> m (Either PusherError Users)
users pusher chan =
liftIO $
runExceptT $ do
requestParams <- liftIO $ Pusher.mkUsersRequest pusher chan <$> getTime
HTTP.get (pusherConnectionManager pusher) requestParams
notify :: MonadIO m => Pusher -> Notification -> m (Either PusherError ())
notify pusher notification =
liftIO $
runExceptT $ do
(requestParams, requestBody) <-
ExceptT $ Pusher.mkNotifyRequest pusher notification <$> getTime
HTTP.post (pusherConnectionManager pusher) requestParams requestBody
parseWebhookPayload ::
Pusher
-> [(BC.ByteString, BC.ByteString)]
-> BC.ByteString
-> Maybe WebhookPayload
parseWebhookPayload pusher =
let credentials = pusherCredentials pusher
ourAppKey = credentialsAppKey credentials
ourAppSecret = credentialsAppSecret credentials
lookupKeysSecret whAppKey =
if whAppKey == ourAppKey
then Just ourAppSecret
else Nothing
in parseWebhookPayloadWith lookupKeysSecret