{-# LANGUAGE QuasiQuotes #-}

-- | [LinkedIn Authenticating with OAuth 2.0 Overview](https://learn.microsoft.com/en-us/linkedin/shared/authentication/authentication?context=linkedin%2Fcontext)
module Network.OAuth2.Provider.LinkedIn 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)

sampleLinkedInAuthorizationCodeApp :: AuthorizationCodeApplication
sampleLinkedInAuthorizationCodeApp :: AuthorizationCodeApplication
sampleLinkedInAuthorizationCodeApp =
  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
"r_liteprofile"]
    , 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-linkedin-authorization-code-app"
    , acTokenRequestAuthenticationMethod :: ClientAuthenticationMethod
acTokenRequestAuthenticationMethod = ClientAuthenticationMethod
ClientSecretPost
    }

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

defaultLinkedInIdp :: Idp LinkedIn
defaultLinkedInIdp :: Idp 'LinkedIn
defaultLinkedInIdp =
  Idp
    { idpUserInfoEndpoint :: URI
idpUserInfoEndpoint = [uri|https://api.linkedin.com/v2/me|]
    , idpAuthorizeEndpoint :: URI
idpAuthorizeEndpoint = [uri|https://www.linkedin.com/oauth/v2/authorization|]
    , idpTokenEndpoint :: URI
idpTokenEndpoint = [uri|https://www.linkedin.com/oauth/v2/accessToken|]
    , idpDeviceAuthorizationEndpoint :: Maybe URI
idpDeviceAuthorizationEndpoint = Maybe URI
forall a. Maybe a
Nothing
    }

data LinkedInUser = LinkedInUser
  { LinkedInUser -> Text
localizedFirstName :: Text
  , LinkedInUser -> Text
localizedLastName :: Text
  }
  deriving (Int -> LinkedInUser -> ShowS
[LinkedInUser] -> ShowS
LinkedInUser -> String
(Int -> LinkedInUser -> ShowS)
-> (LinkedInUser -> String)
-> ([LinkedInUser] -> ShowS)
-> Show LinkedInUser
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LinkedInUser -> ShowS
showsPrec :: Int -> LinkedInUser -> ShowS
$cshow :: LinkedInUser -> String
show :: LinkedInUser -> String
$cshowList :: [LinkedInUser] -> ShowS
showList :: [LinkedInUser] -> ShowS
Show, (forall x. LinkedInUser -> Rep LinkedInUser x)
-> (forall x. Rep LinkedInUser x -> LinkedInUser)
-> Generic LinkedInUser
forall x. Rep LinkedInUser x -> LinkedInUser
forall x. LinkedInUser -> Rep LinkedInUser x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LinkedInUser -> Rep LinkedInUser x
from :: forall x. LinkedInUser -> Rep LinkedInUser x
$cto :: forall x. Rep LinkedInUser x -> LinkedInUser
to :: forall x. Rep LinkedInUser x -> LinkedInUser
Generic, LinkedInUser -> LinkedInUser -> Bool
(LinkedInUser -> LinkedInUser -> Bool)
-> (LinkedInUser -> LinkedInUser -> Bool) -> Eq LinkedInUser
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LinkedInUser -> LinkedInUser -> Bool
== :: LinkedInUser -> LinkedInUser -> Bool
$c/= :: LinkedInUser -> LinkedInUser -> Bool
/= :: LinkedInUser -> LinkedInUser -> Bool
Eq)

instance FromJSON LinkedInUser