Weibo.hs

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

module IDP.Weibo where
import           Data.Aeson
import           Data.Aeson.Types
import           Data.Bifunctor
import           Data.Hashable
import           Data.Text.Lazy       (Text)
import qualified Data.Text.Lazy       as TL
import           GHC.Generics
import           Keys
import           Network.OAuth.OAuth2
import           Types
import           URI.ByteString
import           URI.ByteString.QQ
import           Utils

data Weibo = Weibo deriving (Show, Generic)

instance Hashable Weibo

instance IDP Weibo

instance HasLabel Weibo

instance HasTokenReq Weibo where
  tokenReq _ mgr = fetchAccessToken mgr weiboKey

-- fetch user info via
-- GET
-- access token in query param only
instance HasUserReq Weibo where
  userReq _ mgr at = do
    re <- parseResponseJSON <$> authGetBS2 mgr at userInfoUri
    return (second toLoginUser re)

instance HasAuthUri Weibo where
  authUri _ = createCodeUri weiboKey [ ("state", "Weibo.test-state-123")
                                        ]

-- TODO: 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 where
    parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '_' }
instance FromJSON WeiboUser where
    parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '_' }

userInfoUri :: URI
userInfoUri = [uri|https://api.weibo.com/2/account/get_uid.json|]

toLoginUser :: WeiboUID -> LoginUser
toLoginUser ouser = LoginUser { loginUserName = TL.pack $ show $ uid ouser }