{-# LANGUAGE QuasiQuotes #-}

-- | [Twitter OAuth2 guide](https://developer.twitter.com/en/docs/authentication/oauth-2-0/authorization-code)
module Network.OAuth2.Provider.Twitter 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.Char (toLower)
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

sampleTwitterAuthorizationCodeApp :: AuthorizationCodeApplication
sampleTwitterAuthorizationCodeApp :: AuthorizationCodeApplication
sampleTwitterAuthorizationCodeApp =
  AuthorizationCodeApplication
    { acClientId :: ClientId
acClientId = ClientId
""
    , acClientSecret :: ClientSecret
acClientSecret = ClientSecret
""
    , acScope :: Set Scope
acScope = [Scope] -> Set Scope
forall a. Ord a => [a] -> Set a
Set.fromList [Scope
"tweet.read", Scope
"users.read"]
    , acAuthorizeState :: AuthorizeState
acAuthorizeState = AuthorizeState
"CHANGE_ME"
    , acRedirectUri :: URI
acRedirectUri = [uri|http://localhost|]
    , acName :: Text
acName = Text
"sample-twitter-authorization-code-app"
    , acTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
acTokenRequestAuthenticationMethod = ClientAuthenticationMethod
ClientSecretBasic
    , acAuthorizeRequestExtraParams :: Map Text Text
acAuthorizeRequestExtraParams = Map Text Text
forall k a. Map k a
Map.empty
    }

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 = IdpApplication i a
-> Manager -> AccessToken -> ExceptT ByteString m b
forall {k} (m :: * -> *) a b (i :: k).
(MonadIO m, HasUserInfoRequest a, FromJSON b) =>
IdpApplication i a
-> Manager -> AccessToken -> ExceptT ByteString m b
conduitUserInfoRequest

defaultTwitterIdp :: Idp Twitter
defaultTwitterIdp :: Idp 'Twitter
defaultTwitterIdp =
  Idp
    { idpUserInfoEndpoint :: URI
idpUserInfoEndpoint = [uri|https://api.twitter.com/2/users/me|]
    , idpAuthorizeEndpoint :: URI
idpAuthorizeEndpoint = [uri|https://twitter.com/i/oauth2/authorize|]
    , idpTokenEndpoint :: URI
idpTokenEndpoint = [uri|https://api.twitter.com/2/oauth2/token|]
    , idpDeviceAuthorizationEndpoint :: Maybe URI
idpDeviceAuthorizationEndpoint = Maybe URI
forall a. Maybe a
Nothing
    }

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

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

instance FromJSON TwitterUserResp where
  -- 15 = length "twitterUserResp"
  parseJSON :: Value -> Parser TwitterUserResp
parseJSON = Options -> Value -> Parser TwitterUserResp
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON (Options
defaultOptions {fieldLabelModifier = map toLower . drop 15})

instance FromJSON TwitterUser