{-# LANGUAGE QuasiQuotes #-}

-- | [Sign in with Slack](https://api.slack.com/authentication/sign-in-with-slack)
--
--   * [Using OAuth 2.0](https://api.slack.com/legacy/oauth)
module Network.OAuth2.Provider.Slack where

import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Trans.Except (ExceptT (..))
import Data.Aeson (FromJSON)
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 (uri)

sampleSlackAuthorizationCodeApp :: AuthorizationCodeApplication
sampleSlackAuthorizationCodeApp :: AuthorizationCodeApplication
sampleSlackAuthorizationCodeApp =
  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
"openid", Scope
"profile"]
    , 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|]
    , acTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
acTokenRequestAuthenticationMethod = ClientAuthenticationMethod
ClientSecretBasic
    , acName :: Text
acName = Text
"sample-slack-authorization-code-app"
    }

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

-- https://slack.com/.well-known/openid-configuration
defaultSlackIdp :: Idp Slack
defaultSlackIdp :: Idp 'Slack
defaultSlackIdp =
  Idp
    { idpUserInfoEndpoint :: URI
idpUserInfoEndpoint = [uri|https://slack.com/api/openid.connect.userInfo|]
    , idpAuthorizeEndpoint :: URI
idpAuthorizeEndpoint = [uri|https://slack.com/openid/connect/authorize|]
    , idpTokenEndpoint :: URI
idpTokenEndpoint = [uri|https://slack.com/api/openid.connect.token|]
    , idpDeviceAuthorizationEndpoint :: Maybe URI
idpDeviceAuthorizationEndpoint = Maybe URI
forall a. Maybe a
Nothing
    }

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

instance FromJSON SlackUser