module Network.Pusher.Webhook
( Webhooks (..),
WebhookEv (..),
WebhookPayload (..),
parseAppKeyHdr,
parseAuthSignatureHdr,
parseWebhooksBody,
verifyWebhooksBody,
parseWebhookPayloadWith,
)
where
import qualified Crypto.Hash as HASH
import qualified Crypto.MAC.HMAC as HMAC
import Data.Aeson ((.:))
import qualified Data.Aeson as A
import Data.ByteArray (convert)
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as BC
import Data.ByteString.Lazy (fromStrict)
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Char (toLower)
import Data.Function (on)
import Data.Maybe (listToMaybe, mapMaybe)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import Data.Word (Word64)
import Network.Pusher.Protocol (User (..))
data Webhooks
= Webhooks
{ Webhooks -> Word64
timeMs :: Word64,
Webhooks -> [WebhookEv]
webhookEvs :: [WebhookEv]
}
deriving (Webhooks -> Webhooks -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Webhooks -> Webhooks -> Bool
$c/= :: Webhooks -> Webhooks -> Bool
== :: Webhooks -> Webhooks -> Bool
$c== :: Webhooks -> Webhooks -> Bool
Eq, Int -> Webhooks -> ShowS
[Webhooks] -> ShowS
Webhooks -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Webhooks] -> ShowS
$cshowList :: [Webhooks] -> ShowS
show :: Webhooks -> String
$cshow :: Webhooks -> String
showsPrec :: Int -> Webhooks -> ShowS
$cshowsPrec :: Int -> Webhooks -> ShowS
Show)
instance A.FromJSON Webhooks where
parseJSON :: Value -> Parser Webhooks
parseJSON =
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Webhooks" forall a b. (a -> b) -> a -> b
$ \Object
v ->
Word64 -> [WebhookEv] -> Webhooks
Webhooks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"time_ms" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"events"
data WebhookEv
=
ChannelOccupiedEv {WebhookEv -> Text
onChannel :: T.Text}
|
ChannelVacatedEv {onChannel :: T.Text}
|
MemberAddedEv
{ onChannel :: T.Text,
WebhookEv -> User
withUser :: User
}
|
MemberRemovedEv
{ onChannel :: T.Text,
withUser :: User
}
|
ClientEv
{ onChannel :: T.Text,
WebhookEv -> Text
clientEvName :: T.Text,
WebhookEv -> Maybe Value
clientEvBody :: Maybe A.Value,
WebhookEv -> Text
withSocketId :: T.Text,
WebhookEv -> Maybe User
withPossibleUser :: Maybe User
}
deriving (WebhookEv -> WebhookEv -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebhookEv -> WebhookEv -> Bool
$c/= :: WebhookEv -> WebhookEv -> Bool
== :: WebhookEv -> WebhookEv -> Bool
$c== :: WebhookEv -> WebhookEv -> Bool
Eq, Int -> WebhookEv -> ShowS
[WebhookEv] -> ShowS
WebhookEv -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebhookEv] -> ShowS
$cshowList :: [WebhookEv] -> ShowS
show :: WebhookEv -> String
$cshow :: WebhookEv -> String
showsPrec :: Int -> WebhookEv -> ShowS
$cshowsPrec :: Int -> WebhookEv -> ShowS
Show)
instance A.FromJSON WebhookEv where
parseJSON :: Value -> Parser WebhookEv
parseJSON =
forall a. String -> (Object -> Parser a) -> Value -> Parser a
A.withObject String
"Webhooks" forall a b. (a -> b) -> a -> b
$ \Object
v -> do
Text
name <- Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
case Text
name :: T.Text of
Text
"channel_occupied" -> Text -> WebhookEv
ChannelOccupiedEv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel"
Text
"channel_vacated" -> Text -> WebhookEv
ChannelVacatedEv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel"
Text
"member_added" ->
Text -> User -> WebhookEv
MemberAddedEv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> User
User forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id")
Text
"member_removed" ->
Text -> User -> WebhookEv
MemberRemovedEv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Text -> User
User forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id")
Text
"client_event" ->
Text -> Text -> Maybe Value -> Text -> Maybe User -> WebhookEv
ClientEv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"channel" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"event"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. FromJSON a => ByteString -> Maybe a
A.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"data")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"socket_id"
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> User
User forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"user_id")
Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Unknown client event. Got: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Object
v
data WebhookPayload
= WebhookPayload
{
WebhookPayload -> ByteString
xPusherKey :: B.ByteString,
WebhookPayload -> ByteString
xPusherSignature :: B.ByteString,
WebhookPayload -> Webhooks
webhooks :: Webhooks
}
deriving (WebhookPayload -> WebhookPayload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebhookPayload -> WebhookPayload -> Bool
$c/= :: WebhookPayload -> WebhookPayload -> Bool
== :: WebhookPayload -> WebhookPayload -> Bool
$c== :: WebhookPayload -> WebhookPayload -> Bool
Eq, Int -> WebhookPayload -> ShowS
[WebhookPayload] -> ShowS
WebhookPayload -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebhookPayload] -> ShowS
$cshowList :: [WebhookPayload] -> ShowS
show :: WebhookPayload -> String
$cshow :: WebhookPayload -> String
showsPrec :: Int -> WebhookPayload -> ShowS
$cshowsPrec :: Int -> WebhookPayload -> ShowS
Show)
parseAppKeyHdr :: BC.ByteString -> BC.ByteString -> Maybe B.ByteString
parseAppKeyHdr :: ByteString -> ByteString -> Maybe ByteString
parseAppKeyHdr ByteString
key ByteString
value
| forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) ((Char -> Char) -> ByteString -> ByteString
BC.map Char -> Char
toLower) ByteString
key ByteString
"X-Pusher-Key" = forall a. a -> Maybe a
Just ByteString
value
| Bool
otherwise = forall a. Maybe a
Nothing
parseAuthSignatureHdr :: BC.ByteString -> BC.ByteString -> Maybe B.ByteString
parseAuthSignatureHdr :: ByteString -> ByteString -> Maybe ByteString
parseAuthSignatureHdr ByteString
key ByteString
value
| forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on forall a. Eq a => a -> a -> Bool
(==) ((Char -> Char) -> ByteString -> ByteString
BC.map Char -> Char
toLower) ByteString
key ByteString
"X-Pusher-Signature" = forall a. a -> Maybe a
Just ByteString
value
| Bool
otherwise = forall a. Maybe a
Nothing
parseWebhooksBody :: BC.ByteString -> Maybe Webhooks
parseWebhooksBody :: ByteString -> Maybe Webhooks
parseWebhooksBody = forall a. FromJSON a => ByteString -> Maybe a
A.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
fromStrict
verifyWebhooksBody :: B.ByteString -> B.ByteString -> BC.ByteString -> Bool
verifyWebhooksBody :: ByteString -> ByteString -> ByteString -> Bool
verifyWebhooksBody ByteString
appSecret ByteString
authSignature ByteString
body =
let actualSignature :: ByteString
actualSignature =
ByteString -> ByteString
B16.encode forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
HMAC.hmac ByteString
appSecret ByteString
body :: HMAC.HMAC HASH.SHA256)
in ByteString
authSignature forall a. Eq a => a -> a -> Bool
== ByteString
actualSignature
parseWebhookPayloadWith ::
(B.ByteString -> Maybe B.ByteString) ->
[(BC.ByteString, BC.ByteString)] ->
BC.ByteString ->
Maybe WebhookPayload
parseWebhookPayloadWith :: (ByteString -> Maybe ByteString)
-> [(ByteString, ByteString)] -> ByteString -> Maybe WebhookPayload
parseWebhookPayloadWith ByteString -> Maybe ByteString
lookupKeysSecret [(ByteString, ByteString)]
headers ByteString
body = do
ByteString
appKey <- forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Maybe ByteString
parseAppKeyHdr) forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)]
headers
ByteString
authSignature <- forall a. [a] -> Maybe a
listToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ByteString -> ByteString -> Maybe ByteString
parseAuthSignatureHdr) forall a b. (a -> b) -> a -> b
$ [(ByteString, ByteString)]
headers
ByteString
appSecret <- ByteString -> Maybe ByteString
lookupKeysSecret ByteString
appKey
() <-
if ByteString -> ByteString -> ByteString -> Bool
verifyWebhooksBody ByteString
appSecret ByteString
authSignature ByteString
body
then forall a. a -> Maybe a
Just ()
else forall a. Maybe a
Nothing
Webhooks
whs <- ByteString -> Maybe Webhooks
parseWebhooksBody ByteString
body
forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> Webhooks -> WebhookPayload
WebhookPayload ByteString
appKey ByteString
authSignature Webhooks
whs