{-# LANGUAGE FlexibleContexts #-}

-- |
-- Module      : Network.Pusher.Internal.Auth
-- Description : Functions to perform authentication (generate auth signatures)
-- Copyright   : (c) Will Sewell, 2016
-- Licence     : MIT
-- Maintainer  : me@willsewell.com
-- Stability   : stable
--
-- This module contains helper functions for authenticating HTTP requests, as
-- well as publicly facing functions for authentication private and presence
-- channel users; these functions are re-exported in the main Pusher module.
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')

-- | Generate the required query string parameters required to send API requests
--  to Pusher.
makeQS ::
  Token ->
  B.ByteString ->
  B.ByteString ->
  -- | Any additional parameters.
  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 =
  -- Generate all required parameters and add them to the list of existing ones
  -- Parameters are:
  -- - In alphabetical order
  -- - Keys are lower case
  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)
            )
          ]
      -- Generate the auth signature from the list of parameters
      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 -- Add the auth string to the list
      ((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))

-- | Render key-value tuple mapping of query string parameters into a string.
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

-- | Create a Pusher auth signature of a string using the provided credentials.
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)

-- | Generate an auth signature of the form "app_key:auth_sig" for a user of a
--  private channel.
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

-- | Generate an auth signature of the form "app_key:auth_sig" for a user of a
--  presence channel.
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)

-- | As above, but allows the encoder of the user data to be specified. This is
--  useful for testing because the encoder can be mocked; aeson's encoder enodes
--  JSON object fields in arbitrary orders, which makes it impossible to test.
authenticatePresenceWithEncoder ::
  -- | The encoder of the user data.
  (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