{-# LANGUAGE QuasiQuotes #-}

-- | [DropBox oauth guide](https://developers.dropbox.com/oauth-guide)
module Network.OAuth2.Provider.DropBox 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

sampleDropBoxAuthorizationCodeApp :: AuthorizationCodeApplication
sampleDropBoxAuthorizationCodeApp :: AuthorizationCodeApplication
sampleDropBoxAuthorizationCodeApp =
  AuthorizationCodeApplication
    { acClientId :: ClientId
acClientId = ClientId
""
    , acClientSecret :: ClientSecret
acClientSecret = ClientSecret
""
    , acScope :: Set Scope
acScope = forall a. Set a
Set.empty
    , acAuthorizeState :: AuthorizeState
acAuthorizeState = AuthorizeState
"CHANGE_ME"
    , acAuthorizeRequestExtraParams :: Map Text Text
acAuthorizeRequestExtraParams = forall k a. Map k a
Map.empty
    , acRedirectUri :: URI
acRedirectUri = [uri|http://localhost|]
    , acName :: Text
acName = Text
"sample-dropbox-authorization-code-app"
    , 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 = 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 (\Manager
mgr AccessToken
at URI
url -> forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
Manager
-> AccessToken
-> URI
-> [(ByteString, ByteString)]
-> ExceptT ByteString m a
authPostJSON Manager
mgr AccessToken
at URI
url [])

defaultDropBoxIdp :: Idp DropBox
defaultDropBoxIdp :: Idp 'DropBox
defaultDropBoxIdp =
  Idp
    { idpAuthorizeEndpoint :: URI
idpAuthorizeEndpoint = [uri|https://www.dropbox.com/1/oauth2/authorize|]
    , idpTokenEndpoint :: URI
idpTokenEndpoint = [uri|https://api.dropboxapi.com/oauth2/token|]
    , -- https://www.dropbox.com/developers/documentation/http/documentation#users-get_current_account
      idpUserInfoEndpoint :: URI
idpUserInfoEndpoint = [uri|https://api.dropboxapi.com/2/users/get_current_account|]
    , idpDeviceAuthorizationEndpoint :: Maybe URI
idpDeviceAuthorizationEndpoint = forall a. Maybe a
Nothing
    }

newtype DropBoxUserName = DropBoxUserName {DropBoxUserName -> Text
displayName :: Text}
  deriving (Int -> DropBoxUserName -> ShowS
[DropBoxUserName] -> ShowS
DropBoxUserName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DropBoxUserName] -> ShowS
$cshowList :: [DropBoxUserName] -> ShowS
show :: DropBoxUserName -> String
$cshow :: DropBoxUserName -> String
showsPrec :: Int -> DropBoxUserName -> ShowS
$cshowsPrec :: Int -> DropBoxUserName -> ShowS
Show, forall x. Rep DropBoxUserName x -> DropBoxUserName
forall x. DropBoxUserName -> Rep DropBoxUserName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DropBoxUserName x -> DropBoxUserName
$cfrom :: forall x. DropBoxUserName -> Rep DropBoxUserName x
Generic)

data DropBoxUser = DropBoxUser
  { DropBoxUser -> Text
email :: Text
  , DropBoxUser -> DropBoxUserName
name :: DropBoxUserName
  }
  deriving (Int -> DropBoxUser -> ShowS
[DropBoxUser] -> ShowS
DropBoxUser -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DropBoxUser] -> ShowS
$cshowList :: [DropBoxUser] -> ShowS
show :: DropBoxUser -> String
$cshow :: DropBoxUser -> String
showsPrec :: Int -> DropBoxUser -> ShowS
$cshowsPrec :: Int -> DropBoxUser -> ShowS
Show, forall x. Rep DropBoxUser x -> DropBoxUser
forall x. DropBoxUser -> Rep DropBoxUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DropBoxUser x -> DropBoxUser
$cfrom :: forall x. DropBoxUser -> Rep DropBoxUser x
Generic)

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

instance FromJSON DropBoxUser