{-# LANGUAGE QuasiQuotes #-}

-- | [StackExchange authentication guide](https://api.stackexchange.com/docs/authentication)
--
--    * [StackExchange Apps page](https://stackapps.com/apps/oauth)
module Network.OAuth2.Provider.StackExchange where

import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Except (ExceptT (..))
import Data.Aeson
import Data.ByteString (ByteString)
import Data.ByteString.Lazy.Char8 qualified as BSL
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text.Lazy (Text)
import GHC.Generics
import Network.HTTP.Conduit (Manager)
import Network.OAuth.OAuth2
import Network.OAuth2.Experiment
import Network.OAuth2.Provider
import URI.ByteString (URI)
import URI.ByteString.QQ (uri)

-- fix key from your application edit page
-- https://stackapps.com/apps/oauth
stackexchangeAppKey :: ByteString
stackexchangeAppKey :: ByteString
stackexchangeAppKey = ByteString
""

userInfoEndpoint :: URI
userInfoEndpoint :: URI
userInfoEndpoint =
  [(ByteString, ByteString)] -> URI -> URI
forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams
    [ (ByteString
"key", ByteString
stackexchangeAppKey)
    , (ByteString
"site", ByteString
"stackoverflow")
    ]
    [uri|https://api.stackexchange.com/2.2/me|]

sampleStackExchangeAuthorizationCodeApp :: AuthorizationCodeApplication
sampleStackExchangeAuthorizationCodeApp :: AuthorizationCodeApplication
sampleStackExchangeAuthorizationCodeApp =
  AuthorizationCodeApplication
    { acClientId :: ClientId
acClientId = ClientId
""
    , acClientSecret :: ClientSecret
acClientSecret = ClientSecret
""
    , acScope :: Set Scope
acScope = Set Scope
forall a. Set a
Set.empty
    , acAuthorizeState :: AuthorizeState
acAuthorizeState = AuthorizeState
"CHANGE_ME"
    , acAuthorizeRequestExtraParams :: Map Text Text
acAuthorizeRequestExtraParams = Map Text Text
forall k a. Map k a
Map.empty
    , acRedirectUri :: URI
acRedirectUri = [uri|http://localhost|]
    , acName :: Text
acName = Text
"sample-stackexchange-authorization-code-app"
    , acTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
acTokenRequestAuthenticationMethod = ClientAuthenticationMethod
ClientSecretPost
    }

fetchUserInfo ::
  (MonadIO m, HasUserInfoRequest a, FromJSON b) =>
  IdpApplication i a ->
  Manager ->
  AccessToken ->
  ExceptT BSL.ByteString m b
fetchUserInfo :: forall {k} (m :: * -> *) a b (i :: k).
(MonadIO m, HasUserInfoRequest a, FromJSON b) =>
IdpApplication i a
-> Manager -> AccessToken -> ExceptT ByteString m b
fetchUserInfo = (Manager -> AccessToken -> URI -> ExceptT ByteString m b)
-> IdpApplication i a
-> Manager
-> AccessToken
-> ExceptT ByteString m b
forall {k} (m :: * -> *) a b (i :: k).
(MonadIO m, HasUserInfoRequest a, FromJSON b) =>
(Manager -> AccessToken -> URI -> ExceptT ByteString m b)
-> IdpApplication i a
-> Manager
-> AccessToken
-> ExceptT ByteString m b
conduitUserInfoRequestWithCustomMethod (APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m b
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSONWithAuthMethod APIAuthenticationMethod
AuthInRequestQuery)

defaultStackExchangeIdp :: Idp StackExchange
defaultStackExchangeIdp :: Idp 'StackExchange
defaultStackExchangeIdp =
  Idp
    { -- Only StackExchange has such specical app key which has to be append in userinfo uri.
      -- I feel it's not worth to invent a way to read from config
      -- file which would break the generic of Idp data type.
      -- Until discover a easier way, hard code for now.
      idpUserInfoEndpoint :: URI
idpUserInfoEndpoint = URI
userInfoEndpoint
    , idpAuthorizeEndpoint :: URI
idpAuthorizeEndpoint = [uri|https://stackexchange.com/oauth|]
    , idpTokenEndpoint :: URI
idpTokenEndpoint = [uri|https://stackexchange.com/oauth/access_token|]
    , idpDeviceAuthorizationEndpoint :: Maybe URI
idpDeviceAuthorizationEndpoint = Maybe URI
forall a. Maybe a
Nothing
    }

data StackExchangeResp = StackExchangeResp
  { StackExchangeResp -> Bool
hasMore :: Bool
  , StackExchangeResp -> Integer
quotaMax :: Integer
  , StackExchangeResp -> Integer
quotaRemaining :: Integer
  , StackExchangeResp -> [StackExchangeUser]
items :: [StackExchangeUser]
  }
  deriving (Int -> StackExchangeResp -> ShowS
[StackExchangeResp] -> ShowS
StackExchangeResp -> String
(Int -> StackExchangeResp -> ShowS)
-> (StackExchangeResp -> String)
-> ([StackExchangeResp] -> ShowS)
-> Show StackExchangeResp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackExchangeResp -> ShowS
showsPrec :: Int -> StackExchangeResp -> ShowS
$cshow :: StackExchangeResp -> String
show :: StackExchangeResp -> String
$cshowList :: [StackExchangeResp] -> ShowS
showList :: [StackExchangeResp] -> ShowS
Show, (forall x. StackExchangeResp -> Rep StackExchangeResp x)
-> (forall x. Rep StackExchangeResp x -> StackExchangeResp)
-> Generic StackExchangeResp
forall x. Rep StackExchangeResp x -> StackExchangeResp
forall x. StackExchangeResp -> Rep StackExchangeResp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StackExchangeResp -> Rep StackExchangeResp x
from :: forall x. StackExchangeResp -> Rep StackExchangeResp x
$cto :: forall x. Rep StackExchangeResp x -> StackExchangeResp
to :: forall x. Rep StackExchangeResp x -> StackExchangeResp
Generic)

data StackExchangeUser = StackExchangeUser
  { StackExchangeUser -> Integer
userId :: Integer
  , StackExchangeUser -> Text
displayName :: Text
  , StackExchangeUser -> Text
profileImage :: Text
  }
  deriving (Int -> StackExchangeUser -> ShowS
[StackExchangeUser] -> ShowS
StackExchangeUser -> String
(Int -> StackExchangeUser -> ShowS)
-> (StackExchangeUser -> String)
-> ([StackExchangeUser] -> ShowS)
-> Show StackExchangeUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StackExchangeUser -> ShowS
showsPrec :: Int -> StackExchangeUser -> ShowS
$cshow :: StackExchangeUser -> String
show :: StackExchangeUser -> String
$cshowList :: [StackExchangeUser] -> ShowS
showList :: [StackExchangeUser] -> ShowS
Show, (forall x. StackExchangeUser -> Rep StackExchangeUser x)
-> (forall x. Rep StackExchangeUser x -> StackExchangeUser)
-> Generic StackExchangeUser
forall x. Rep StackExchangeUser x -> StackExchangeUser
forall x. StackExchangeUser -> Rep StackExchangeUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. StackExchangeUser -> Rep StackExchangeUser x
from :: forall x. StackExchangeUser -> Rep StackExchangeUser x
$cto :: forall x. Rep StackExchangeUser x -> StackExchangeUser
to :: forall x. Rep StackExchangeUser x -> StackExchangeUser
Generic)

instance FromJSON StackExchangeResp where
  parseJSON :: Value -> Parser StackExchangeResp
parseJSON = Options -> Value -> Parser StackExchangeResp
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier = camelTo2 '_'}

instance FromJSON StackExchangeUser where
  parseJSON :: Value -> Parser StackExchangeUser
parseJSON = Options -> Value -> Parser StackExchangeUser
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
defaultOptions {fieldLabelModifier = camelTo2 '_'}

appendStackExchangeAppKey :: URI -> ByteString -> URI
appendStackExchangeAppKey :: URI -> ByteString -> URI
appendStackExchangeAppKey URI
useruri ByteString
k = [(ByteString, ByteString)] -> URI -> URI
forall a. [(ByteString, ByteString)] -> URIRef a -> URIRef a
appendQueryParams [(ByteString
"key", ByteString
k)] URI
useruri