{-# 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 =
Query -> Query
forall b. [(ByteString, b)] -> [(ByteString, b)]
alphabeticalOrder (Query -> Query) -> (Query -> Query) -> Query -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Query -> Query
forall b. [(ByteString, b)] -> [(ByteString, b)]
lowercaseKeys (Query -> Query) -> (Query -> Query) -> Query -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Query
params Query -> Query -> Query
forall a. [a] -> [a] -> [a]
++) (Query -> Query) -> Query -> Query
forall a b. (a -> b) -> a -> b
$
[ (ByteString
"auth_key", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Token -> ByteString
tokenKey Token
token),
(ByteString
"auth_timestamp", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ Word64 -> ByteString
forall a b. (Show a, IsString b) => a -> b
show' Word64
timestamp),
(ByteString
"auth_version", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"1.0"),
( ByteString
"body_md5",
ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just
(ByteString -> Maybe ByteString) -> ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B16.encode
(ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Digest MD5 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> Digest MD5
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) (ByteString -> ByteString) -> ByteString -> ByteString
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", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
authSig) (ByteString, Maybe ByteString) -> Query -> Query
forall a. a -> [a] -> [a]
: Query
allParams)
where
alphabeticalOrder :: [(ByteString, b)] -> [(ByteString, b)]
alphabeticalOrder = ((ByteString, b) -> ByteString)
-> [(ByteString, b)] -> [(ByteString, b)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortWith (ByteString, b) -> ByteString
forall a b. (a, b) -> a
fst
lowercaseKeys :: [(ByteString, c)] -> [(ByteString, c)]
lowercaseKeys = ((ByteString, c) -> (ByteString, c))
-> [(ByteString, c)] -> [(ByteString, c)]
forall a b. (a -> b) -> [a] -> [b]
map ((ByteString -> ByteString) -> (ByteString, c) -> (ByteString, c)
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
"&" ([ByteString] -> ByteString)
-> (Query -> [ByteString]) -> Query -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ByteString, Maybe ByteString) -> ByteString)
-> Query -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, Maybe ByteString) -> ByteString
forall p. (Semigroup p, IsString p) => (p, Maybe p) -> p
formQueryItem
where
formQueryItem :: (p, Maybe p) -> p
formQueryItem (p
k, Just p
v) = p
k p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
"=" p -> p -> p
forall a. Semigroup a => a -> a -> a
<> p
v
formQueryItem (p
k, Maybe p
Nothing) = p
k
authSignature :: B.ByteString -> B.ByteString -> B.ByteString
authSignature :: ByteString -> ByteString -> ByteString
authSignature ByteString
appSecret ByteString
authString =
ByteString -> ByteString
B16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
HMAC SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert (ByteString -> ByteString -> HMAC SHA256
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 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
socketID Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
channel)
in Token -> ByteString
tokenKey Token
token ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sig
authenticatePresence ::
A.ToJSON a => Token -> T.Text -> T.Text -> a -> B.ByteString
authenticatePresence :: Token -> Text -> Text -> a -> ByteString
authenticatePresence =
(a -> Text) -> Token -> Text -> Text -> a -> ByteString
forall a. (a -> Text) -> Token -> Text -> Text -> a -> ByteString
authenticatePresenceWithEncoder
(Text -> Text
TL.toStrict (Text -> Text) -> (a -> Text) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TL.toLazyText (Builder -> Text) -> (a -> Builder) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Builder
forall a. ToJSON a => a -> Builder
A.encodeToTextBuilder (Value -> Builder) -> (a -> Value) -> a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
A.toJSON)
authenticatePresenceWithEncoder ::
(a -> T.Text) ->
Token ->
T.Text ->
T.Text ->
a ->
B.ByteString
authenticatePresenceWithEncoder :: (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 (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$
Text
socketID Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
channel Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> 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 ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
":" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
sig