{-# 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
-> ByteString
-> ByteString
-> Query
-> ByteString
-> Word64
-> Query
makeQS Token
token ByteString
method ByteString
path Query
params ByteString
body Word64
timestamp =
let allParams :: Query
allParams =
forall {b}. [(ByteString, b)] -> [(ByteString, b)]
alphabeticalOrder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. [(ByteString, b)] -> [(ByteString, b)]
lowercaseKeys forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query
params forall a. [a] -> [a] -> [a]
++) forall a b. (a -> b) -> a -> b
$
[ (ByteString
"auth_key", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Token -> ByteString
tokenKey Token
token),
(ByteString
"auth_timestamp", forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b. (Show a, IsString b) => a -> b
show' Word64
timestamp),
(ByteString
"auth_version", forall a. a -> Maybe a
Just ByteString
"1.0"),
( ByteString
"body_md5",
forall a. a -> Maybe a
Just
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B16.encode
forall a b. (a -> b) -> a -> b
$ forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
Hash.hash ByteString
body :: Hash.Digest Hash.MD5)
)
]
authSig :: ByteString
authSig =
ByteString -> ByteString -> ByteString
authSignature (Token -> ByteString
tokenSecret Token
token) forall a b. (a -> b) -> a -> b
$
ByteString -> [ByteString] -> ByteString
B.intercalate
ByteString
"\n"
[ByteString
method, ByteString
path, Query -> ByteString
formQueryString Query
allParams]
in
((ByteString
"auth_signature", forall a. a -> Maybe a
Just ByteString
authSig) forall a. a -> [a] -> [a]
: Query
allParams)
where
alphabeticalOrder :: [(ByteString, b)] -> [(ByteString, b)]
alphabeticalOrder = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith forall a b. (a, b) -> a
fst
lowercaseKeys :: [(ByteString, c)] -> [(ByteString, c)]
lowercaseKeys = forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((Char -> Char) -> ByteString -> ByteString
BC.map Char -> Char
toLower))
formQueryString :: Query -> B.ByteString
formQueryString :: Query -> ByteString
formQueryString = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"&" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Semigroup a, IsString a) => (a, Maybe a) -> a
formQueryItem
where
formQueryItem :: (a, Maybe a) -> a
formQueryItem (a
k, Just a
v) = a
k forall a. Semigroup a => a -> a -> a
<> a
"=" forall a. Semigroup a => a -> a -> a
<> a
v
formQueryItem (a
k, Maybe a
Nothing) = a
k
authSignature :: B.ByteString -> B.ByteString -> B.ByteString
authSignature :: ByteString -> ByteString -> ByteString
authSignature ByteString
appSecret ByteString
authString =
ByteString -> ByteString
B16.encode forall a b. (a -> b) -> a -> b
$
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (forall key message a.
(ByteArrayAccess key, ByteArrayAccess message, HashAlgorithm a) =>
key -> message -> HMAC a
HMAC.hmac ByteString
appSecret ByteString
authString :: HMAC.HMAC Hash.SHA256)
authenticatePrivate :: Token -> T.Text -> T.Text -> B.ByteString
authenticatePrivate :: Token -> Text -> Text -> ByteString
authenticatePrivate Token
token Text
socketID Text
channel =
let sig :: ByteString
sig =
ByteString -> ByteString -> ByteString
authSignature
(Token -> ByteString
tokenSecret Token
token)
(Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$ Text
socketID forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
channel)
in Token -> ByteString
tokenKey Token
token forall a. Semigroup a => a -> a -> a
<> ByteString
":" forall a. Semigroup a => a -> a -> a
<> ByteString
sig
authenticatePresence ::
A.ToJSON a => Token -> T.Text -> T.Text -> a -> B.ByteString
authenticatePresence :: forall a. ToJSON a => Token -> Text -> Text -> a -> ByteString
authenticatePresence =
forall a. (a -> Text) -> Token -> Text -> Text -> a -> ByteString
authenticatePresenceWithEncoder
(Text -> Text
TL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TL.toLazyText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Builder
A.encodeToTextBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
A.toJSON)
authenticatePresenceWithEncoder ::
(a -> T.Text) ->
Token ->
T.Text ->
T.Text ->
a ->
B.ByteString
authenticatePresenceWithEncoder :: forall a. (a -> Text) -> Token -> Text -> Text -> a -> ByteString
authenticatePresenceWithEncoder a -> Text
userEncoder Token
token Text
socketID Text
channel a
userData =
let authString :: ByteString
authString =
Text -> ByteString
encodeUtf8 forall a b. (a -> b) -> a -> b
$
Text
socketID forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
channel forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> a -> Text
userEncoder a
userData
sig :: ByteString
sig = ByteString -> ByteString -> ByteString
authSignature (Token -> ByteString
tokenSecret Token
token) ByteString
authString
in Token -> ByteString
tokenKey Token
token forall a. Semigroup a => a -> a -> a
<> ByteString
":" forall a. Semigroup a => a -> a -> a
<> ByteString
sig