{-# LANGUAGE FlexibleContexts #-}
module Network.Pusher.Internal.Auth
( authenticatePresence,
authenticatePresenceWithEncoder,
authenticatePrivate,
makeQS,
)
where
import qualified Crypto.Hash as Hash
import qualified Crypto.MAC.HMAC as HMAC
import qualified Data.Aeson as A
import qualified Data.Aeson.Text as A
import Data.Bifunctor (first)
import qualified Data.ByteArray as BA
import qualified Data.ByteString as B
import qualified Data.ByteString.Base16 as B16
import qualified Data.ByteString.Char8 as BC
import Data.Char (toLower)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TL
import Data.Word (Word64)
import GHC.Exts (sortWith)
import Network.HTTP.Types (Query)
import Network.Pusher.Data (Token (..))
import Network.Pusher.Internal.Util (show')
makeQS ::
Token ->
B.ByteString ->
B.ByteString ->
Query ->
B.ByteString ->
Word64 ->
Query
makeQS token method path params body timestamp =
let allParams =
alphabeticalOrder . lowercaseKeys . (params ++) $
[ ("auth_key", Just $ tokenKey token),
("auth_timestamp", Just $ show' timestamp),
("auth_version", Just "1.0"),
( "body_md5",
Just
$ B16.encode
$ BA.convert (Hash.hash body :: Hash.Digest Hash.MD5)
)
]
authSig =
authSignature (tokenSecret token) $
B.intercalate
"\n"
[method, path, formQueryString allParams]
in
(("auth_signature", Just authSig) : allParams)
where
alphabeticalOrder = sortWith fst
lowercaseKeys = map (first (BC.map toLower))
formQueryString :: Query -> B.ByteString
formQueryString = B.intercalate "&" . map formQueryItem
where
formQueryItem (k, Just v) = k <> "=" <> v
formQueryItem (k, Nothing) = k
authSignature :: B.ByteString -> B.ByteString -> B.ByteString
authSignature appSecret authString =
B16.encode $
BA.convert (HMAC.hmac appSecret authString :: HMAC.HMAC Hash.SHA256)
authenticatePrivate :: Token -> T.Text -> T.Text -> B.ByteString
authenticatePrivate token socketID channel =
let sig =
authSignature
(tokenSecret token)
(encodeUtf8 $ socketID <> ":" <> channel)
in tokenKey token <> ":" <> sig
authenticatePresence ::
A.ToJSON a => Token -> T.Text -> T.Text -> a -> B.ByteString
authenticatePresence =
authenticatePresenceWithEncoder
(TL.toStrict . TL.toLazyText . A.encodeToTextBuilder . A.toJSON)
authenticatePresenceWithEncoder ::
(a -> T.Text) ->
Token ->
T.Text ->
T.Text ->
a ->
B.ByteString
authenticatePresenceWithEncoder userEncoder token socketID channel userData =
let authString =
encodeUtf8 $
socketID <> ":" <> channel <> ":" <> userEncoder userData
sig = authSignature (tokenSecret token) authString
in tokenKey token <> ":" <> sig