{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} module IDP.Dropbox where import Data.Aeson import Data.Bifunctor import Data.Hashable import Data.Text.Lazy (Text) import GHC.Generics import Keys import Network.OAuth.OAuth2 import Types import URI.ByteString import URI.ByteString.QQ import Utils data Dropbox = Dropbox deriving (Show, Generic) instance Hashable Dropbox instance IDP Dropbox instance HasLabel Dropbox instance HasTokenReq Dropbox where tokenReq _ mgr = fetchAccessToken mgr dropboxKey instance HasUserReq Dropbox where userReq _ mgr at = do re <- parseResponseJSON <$> authPostBS3 mgr at userInfoUri return (second toLoginUser re) instance HasAuthUri Dropbox where authUri _ = createCodeUri dropboxKey [ ("state", "Dropbox.test-state-123") ] newtype DropboxName = DropboxName { displayName :: Text } deriving (Show, Generic) data DropboxUser = DropboxUser { email :: Text , name :: DropboxName } deriving (Show, Generic) instance FromJSON DropboxName where parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '_' } instance FromJSON DropboxUser where parseJSON = genericParseJSON defaultOptions { fieldLabelModifier = camelTo2 '_' } userInfoUri :: URI userInfoUri = [uri|https://api.dropboxapi.com/2/users/get_current_account|] toLoginUser :: DropboxUser -> LoginUser toLoginUser ouser = LoginUser { loginUserName = displayName $ name ouser }