{-# 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 =
  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 = forall a. Set a
Set.empty
    , acAuthorizeState :: AuthorizeState
acAuthorizeState = AuthorizeState
"CHANGE_ME"
    , acAuthorizeRequestExtraParams :: Map Text Text
acAuthorizeRequestExtraParams = 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 = 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 (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 = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackExchangeResp] -> ShowS
$cshowList :: [StackExchangeResp] -> ShowS
show :: StackExchangeResp -> String
$cshow :: StackExchangeResp -> String
showsPrec :: Int -> StackExchangeResp -> ShowS
$cshowsPrec :: Int -> StackExchangeResp -> ShowS
Show, 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
$cto :: forall x. Rep StackExchangeResp x -> StackExchangeResp
$cfrom :: forall x. StackExchangeResp -> Rep StackExchangeResp x
Generic)

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

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

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

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