{-# 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 = 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 = 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 = 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 = 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TwitterUser] -> ShowS
$cshowList :: [TwitterUser] -> ShowS
show :: TwitterUser -> String
$cshow :: TwitterUser -> String
showsPrec :: Int -> TwitterUser -> ShowS
$cshowsPrec :: Int -> TwitterUser -> ShowS
Show, 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
$cto :: forall x. Rep TwitterUser x -> TwitterUser
$cfrom :: forall x. TwitterUser -> Rep TwitterUser x
Generic)

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

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

instance FromJSON TwitterUser