Dropbox.hs

{-# 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 }