Auth.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE UnicodeSyntax #-}
-- | StackExchange authentication helpers
module Network.StackExchange.Auth
  ( -- * Explicit OAuth 2.0 flow
    explicitUserPermission, explicitAccessToken
    -- * Implicit OAuth 2.0 flow
  , implicitUserPermission
  ) where

import Control.Applicative ((<$>), (*>))
import Control.Exception (throw)
import Data.Monoid ((<>), mconcat)

import           Data.Text.Lazy (Text)
import qualified Data.Text.Lazy as T
import           Data.Text.Lazy.Encoding (decodeUtf8)
import qualified Data.Attoparsec.Text.Lazy as P

import Network.StackExchange.Response
import Network.StackExchange.Request


-- | Construct URI at which user should approve app
explicitUserPermission ∷ Int → Text → Request a n r
explicitUserPermission c r = userPermission c r <> host "https://stackexchange.com/oauth"


-- | Request access_token from StackExchange
explicitAccessToken ∷ Int → Text → Text → Text → Request a n Text
explicitAccessToken c s c' r = mconcat
  [ host "https://stackexchange.com/oauth/access_token"
  , client c
  , secret s
  , code c'
  , redirectURI r
  , parse parseToken
  , method "POST"
  ]
 where
  parseToken bs = case P.eitherResult $ P.parse parser (decodeUtf8 bs) of
    Right t → t
    Left e → throw $ SEException bs ("libstackexchange.accessToken: " ++ show e)

  parser ∷ P.Parser Text
  parser = P.string "access_token=" *> (T.pack <$> P.manyTill P.anyChar (P.char '&'))


-- | Construct URI at which user should approve app
implicitUserPermission ∷ Int → Text → Request a n r
implicitUserPermission c r = userPermission c r <> host "https://stackexchange.com/oauth/dialog"


userPermission ∷ Int → Text → Request a n r
userPermission c r = client c <> redirectURI r