{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

{-
  NOTES: stackexchange API spec and its document just sucks!
-}
module Network.OAuth2.Provider.StackExchange where

import Data.Aeson
import Data.ByteString (ByteString)
import Data.Map.Strict qualified as Map
import Data.Set qualified as Set
import Data.Text.Lazy (Text)
import GHC.Generics
import Network.OAuth.OAuth2
import Network.OAuth2.Experiment
import URI.ByteString
import URI.ByteString.QQ

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

data StackExchange = StackExchange deriving (StackExchange -> StackExchange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StackExchange -> StackExchange -> Bool
$c/= :: StackExchange -> StackExchange -> Bool
== :: StackExchange -> StackExchange -> Bool
$c== :: StackExchange -> StackExchange -> Bool
Eq, Int -> StackExchange -> ShowS
[StackExchange] -> ShowS
StackExchange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StackExchange] -> ShowS
$cshowList :: [StackExchange] -> ShowS
show :: StackExchange -> String
$cshow :: StackExchange -> String
showsPrec :: Int -> StackExchange -> ShowS
$cshowsPrec :: Int -> StackExchange -> ShowS
Show)

type instance IdpUserInfo StackExchange = StackExchangeResp

defaultStackExchangeApp :: IdpApplication 'AuthorizationCode StackExchange
defaultStackExchangeApp :: IdpApplication 'AuthorizationCode StackExchange
defaultStackExchangeApp =
  AuthorizationCodeIdpApplication
    { $sel:idpAppClientId:AuthorizationCodeIdpApplication :: ClientId
idpAppClientId = ClientId
"",
      $sel:idpAppClientSecret:AuthorizationCodeIdpApplication :: ClientSecret
idpAppClientSecret = ClientSecret
"",
      $sel:idpAppScope:AuthorizationCodeIdpApplication :: Set Scope
idpAppScope = forall a. Set a
Set.empty,
      $sel:idpAppAuthorizeState:AuthorizationCodeIdpApplication :: AuthorizeState
idpAppAuthorizeState = AuthorizeState
"CHANGE_ME",
      $sel:idpAppAuthorizeExtraParams:AuthorizationCodeIdpApplication :: Map Text Text
idpAppAuthorizeExtraParams = forall k a. Map k a
Map.empty,
      $sel:idpAppRedirectUri:AuthorizationCodeIdpApplication :: URI
idpAppRedirectUri = [uri|http://localhost|],
      $sel:idpAppName:AuthorizationCodeIdpApplication :: Text
idpAppName = Text
"default-stackexchange-App",
      $sel:idpAppTokenRequestAuthenticationMethod:AuthorizationCodeIdpApplication :: ClientAuthenticationMethod
idpAppTokenRequestAuthenticationMethod = ClientAuthenticationMethod
ClientSecretPost,
      $sel:idp:AuthorizationCodeIdpApplication :: Idp StackExchange
idp = Idp StackExchange
defaultStackexchangeIdp
    }

defaultStackexchangeIdp :: Idp StackExchange
defaultStackexchangeIdp :: Idp StackExchange
defaultStackexchangeIdp =
  Idp
    { $sel:idpFetchUserInfo:Idp :: forall (m :: * -> *).
(FromJSON (IdpUserInfo StackExchange), MonadIO m) =>
Manager
-> AccessToken
-> URI
-> ExceptT ByteString m (IdpUserInfo StackExchange)
idpFetchUserInfo = forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
APIAuthenticationMethod
-> Manager -> AccessToken -> URI -> ExceptT ByteString m a
authGetJSONWithAuthMethod @_ @(IdpUserInfo StackExchange) APIAuthenticationMethod
AuthInRequestQuery,
      -- 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.
      $sel:idpUserInfoEndpoint:Idp :: URI
idpUserInfoEndpoint =
        URI -> ByteString -> URI
appendStackExchangeAppKey
          [uri|https://api.stackexchange.com/2.2/me?site=stackoverflow|]
          ByteString
stackexchangeAppKey,
      $sel:idpAuthorizeEndpoint:Idp :: URI
idpAuthorizeEndpoint = [uri|https://stackexchange.com/oauth|],
      $sel:idpTokenEndpoint:Idp :: URI
idpTokenEndpoint = [uri|https://stackexchange.com/oauth/access_token|]
    }

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