{-# LANGUAGE QuasiQuotes #-}

-- | [微博授权机制](https://open.weibo.com/wiki/%E6%8E%88%E6%9D%83%E6%9C%BA%E5%88%B6)
module Network.OAuth2.Provider.Weibo where

import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Except (ExceptT (..))
import Data.Aeson
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.QQ

sampleWeiboAuthorizationCodeApp :: AuthorizationCodeApplication
sampleWeiboAuthorizationCodeApp :: AuthorizationCodeApplication
sampleWeiboAuthorizationCodeApp =
  AuthorizationCodeApplication
    { acName :: Text
acName = Text
"sample-weibo-authorization-code-app"
    , 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|]
    , acTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
acTokenRequestAuthenticationMethod = ClientAuthenticationMethod
ClientSecretBasic
    }

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)

defaultWeiboIdp :: Idp Weibo
defaultWeiboIdp :: Idp 'Weibo
defaultWeiboIdp =
  Idp
    { idpUserInfoEndpoint :: URI
idpUserInfoEndpoint = [uri|https://api.weibo.com/2/account/get_uid.json|]
    , idpAuthorizeEndpoint :: URI
idpAuthorizeEndpoint = [uri|https://api.weibo.com/oauth2/authorize|]
    , idpTokenEndpoint :: URI
idpTokenEndpoint = [uri|https://api.weibo.com/oauth2/access_token|]
    , idpDeviceAuthorizationEndpoint :: Maybe URI
idpDeviceAuthorizationEndpoint = forall a. Maybe a
Nothing
    }

-- | http://open.weibo.com/wiki/2/users/show
data WeiboUser = WeiboUser
  { WeiboUser -> Integer
id :: Integer
  , WeiboUser -> Text
name :: Text
  , WeiboUser -> Text
screenName :: Text
  }
  deriving (Int -> WeiboUser -> ShowS
[WeiboUser] -> ShowS
WeiboUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WeiboUser] -> ShowS
$cshowList :: [WeiboUser] -> ShowS
show :: WeiboUser -> String
$cshow :: WeiboUser -> String
showsPrec :: Int -> WeiboUser -> ShowS
$cshowsPrec :: Int -> WeiboUser -> ShowS
Show, forall x. Rep WeiboUser x -> WeiboUser
forall x. WeiboUser -> Rep WeiboUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WeiboUser x -> WeiboUser
$cfrom :: forall x. WeiboUser -> Rep WeiboUser x
Generic)

newtype WeiboUID = WeiboUID {WeiboUID -> Integer
uid :: Integer}
  deriving (Int -> WeiboUID -> ShowS
[WeiboUID] -> ShowS
WeiboUID -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WeiboUID] -> ShowS
$cshowList :: [WeiboUID] -> ShowS
show :: WeiboUID -> String
$cshow :: WeiboUID -> String
showsPrec :: Int -> WeiboUID -> ShowS
$cshowsPrec :: Int -> WeiboUID -> ShowS
Show, forall x. Rep WeiboUID x -> WeiboUID
forall x. WeiboUID -> Rep WeiboUID x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WeiboUID x -> WeiboUID
$cfrom :: forall x. WeiboUID -> Rep WeiboUID x
Generic)

instance FromJSON WeiboUID

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