-
-
Notifications
You must be signed in to change notification settings - Fork 54
/
Copy pathWeibo.hs
64 lines (55 loc) · 1.98 KB
/
Weibo.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
{-# 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
{ acName = "sample-weibo-authorization-code-app"
, acClientId = ""
, acClientSecret = ""
, acScope = Set.empty
, acAuthorizeState = "CHANGE_ME"
, acAuthorizeRequestExtraParams = Map.empty
, acRedirectUri = [uri|http://localhost|]
, acTokenRequestAuthenticationMethod = ClientSecretBasic
}
fetchUserInfo ::
(MonadIO m, HasUserInfoRequest a, FromJSON b) =>
IdpApplication i a ->
Manager ->
AccessToken ->
ExceptT BSL.ByteString m b
fetchUserInfo = conduitUserInfoRequestWithCustomMethod (authGetJSONWithAuthMethod AuthInRequestQuery)
defaultWeiboIdp :: Idp Weibo
defaultWeiboIdp =
Idp
{ idpUserInfoEndpoint = [uri|https://api.weibo.com/2/account/get_uid.json|]
, idpAuthorizeEndpoint = [uri|https://api.weibo.com/oauth2/authorize|]
, idpTokenEndpoint = [uri|https://api.weibo.com/oauth2/access_token|]
, idpDeviceAuthorizationEndpoint = Nothing
}
-- | http://open.weibo.com/wiki/2/users/show
data WeiboUser = WeiboUser
{ id :: Integer
, name :: Text
, screenName :: Text
}
deriving (Show, Generic)
newtype WeiboUID = WeiboUID {uid :: Integer}
deriving (Show, Generic)
instance FromJSON WeiboUID
instance FromJSON WeiboUser where
parseJSON = genericParseJSON defaultOptions {fieldLabelModifier = camelTo2 '_'}