{-# 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 = 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|]
    , 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 = (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)

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 = Maybe URI
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
(Int -> WeiboUser -> ShowS)
-> (WeiboUser -> String)
-> ([WeiboUser] -> ShowS)
-> Show WeiboUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WeiboUser -> ShowS
showsPrec :: Int -> WeiboUser -> ShowS
$cshow :: WeiboUser -> String
show :: WeiboUser -> String
$cshowList :: [WeiboUser] -> ShowS
showList :: [WeiboUser] -> ShowS
Show, (forall x. WeiboUser -> Rep WeiboUser x)
-> (forall x. Rep WeiboUser x -> WeiboUser) -> Generic WeiboUser
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
$cfrom :: forall x. WeiboUser -> Rep WeiboUser x
from :: forall x. WeiboUser -> Rep WeiboUser x
$cto :: forall x. Rep WeiboUser x -> WeiboUser
to :: forall x. Rep WeiboUser x -> WeiboUser
Generic)

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

instance FromJSON WeiboUID

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