{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE FlexibleContexts #-}
module Network.Pusher
(
Settings (..),
defaultSettings,
Token (..),
Address (..),
Pusher,
newPusher,
newPusherWithConnManager,
trigger,
channels,
channel,
users,
authenticatePresence,
authenticatePrivate,
PusherError (..),
parseWebhookPayload,
WebhookEv (..),
WebhookPayload (..),
Webhooks (..),
parseAppKeyHdr,
parseAuthSignatureHdr,
parseWebhooksBody,
verifyWebhooksBody,
parseWebhookPayloadWith,
)
where
import Control.Monad.IO.Class
( MonadIO,
liftIO,
)
import qualified Data.Aeson as A
import qualified Data.ByteString as B
import qualified Data.Text as T
import Network.Pusher.Data
( Address (..),
Pusher (..),
Settings (..),
Token (..),
defaultSettings,
newPusher,
newPusherWithConnManager,
)
import Network.Pusher.Error (PusherError (..))
import qualified Network.Pusher.Internal as Pusher
import qualified Network.Pusher.Internal.Auth as Auth
import qualified Network.Pusher.Internal.HTTP as HTTP
import Network.Pusher.Internal.Util (getSystemTimeSeconds)
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 ->
[T.Text] ->
T.Text ->
T.Text ->
Maybe T.Text ->
m (Either PusherError ())
trigger pusher chans event dat socketId = do
(requestParams, requestBody) <-
Pusher.mkTriggerRequest pusher chans event dat socketId
<$> getSystemTimeSeconds
liftIO $ HTTP.post (pConnectionManager pusher) requestParams requestBody
channels ::
MonadIO m =>
Pusher ->
T.Text ->
ChannelsInfoQuery ->
m (Either PusherError ChannelsInfo)
channels pusher prefixFilter attributes = do
requestParams <-
Pusher.mkChannelsRequest pusher prefixFilter attributes
<$> getSystemTimeSeconds
liftIO $ HTTP.get (pConnectionManager pusher) requestParams
channel ::
MonadIO m =>
Pusher ->
B.ByteString ->
ChannelInfoQuery ->
m (Either PusherError FullChannelInfo)
channel pusher chan attributes = do
requestParams <-
Pusher.mkChannelRequest pusher chan attributes <$> getSystemTimeSeconds
liftIO $ HTTP.get (pConnectionManager pusher) requestParams
users :: MonadIO m => Pusher -> B.ByteString -> m (Either PusherError Users)
users pusher chan = do
requestParams <- Pusher.mkUsersRequest pusher chan <$> getSystemTimeSeconds
liftIO $ HTTP.get (pConnectionManager pusher) requestParams
authenticatePrivate :: Pusher -> T.Text -> T.Text -> B.ByteString
authenticatePrivate pusher = Auth.authenticatePrivate (pToken pusher)
authenticatePresence ::
A.ToJSON a => Pusher -> T.Text -> T.Text -> a -> B.ByteString
authenticatePresence pusher = Auth.authenticatePresence (pToken pusher)
parseWebhookPayload ::
Pusher ->
[(B.ByteString, B.ByteString)] ->
B.ByteString ->
Maybe WebhookPayload
parseWebhookPayload pusher =
let token = pToken pusher
ourAppKey = tokenKey token
ourAppSecret = tokenSecret token
lookupKeysSecret whAppKey =
if whAppKey == ourAppKey then Just ourAppSecret else Nothing
in parseWebhookPayloadWith lookupKeysSecret