{-# 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 = Set Scope
forall a. Set a
Set.empty
    , acAuthorizeState :: AuthorizeState
acAuthorizeState = AuthorizeState
"CHANGE_ME"
    , acAuthorizeRequestExtraParams :: Map Text Text
acAuthorizeRequestExtraParams = Map Text Text
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 = (Manager -> AccessToken -> URI -> ExceptT ByteString m b)
-> IdpApplication i a
-> Manager
-> AccessToken
-> ExceptT ByteString m b
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 -> Manager
-> AccessToken
-> URI
-> [(ByteString, ByteString)]
-> ExceptT ByteString m b
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 = Maybe URI
forall a. Maybe a
Nothing
    }

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

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

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

instance FromJSON DropBoxUser