module Unison.Auth.UserInfo where

import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.ByteString.Lazy.Char8 qualified as BL
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Client.TLS qualified as HTTP
import Unison.Auth.Types
import Unison.Prelude

-- | Get user info for an authenticated user.
getUserInfo :: (MonadIO m) => DiscoveryDoc -> AccessToken -> m (Either CredentialFailure UserInfo)
getUserInfo :: forall (m :: * -> *).
MonadIO m =>
DiscoveryDoc -> Text -> m (Either CredentialFailure UserInfo)
getUserInfo (DiscoveryDoc {URI
userInfoEndpoint :: URI
$sel:userInfoEndpoint:DiscoveryDoc :: DiscoveryDoc -> URI
userInfoEndpoint}) Text
accessToken = IO (Either CredentialFailure UserInfo)
-> m (Either CredentialFailure UserInfo)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either CredentialFailure UserInfo)
 -> m (Either CredentialFailure UserInfo))
-> IO (Either CredentialFailure UserInfo)
-> m (Either CredentialFailure UserInfo)
forall a b. (a -> b) -> a -> b
$ do
  Manager
unauthenticatedHttpClient <- IO Manager
HTTP.getGlobalManager
  Request
req <- URI -> IO Request
forall (m :: * -> *). MonadThrow m => URI -> m Request
HTTP.requestFromURI URI
userInfoEndpoint IO Request -> (Request -> Request) -> IO Request
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> ByteString -> Request -> Request
HTTP.applyBearerAuth (Text -> ByteString
Text.encodeUtf8 Text
accessToken)
  Response ByteString
resp <- Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
req Manager
unauthenticatedHttpClient
  case ByteString -> Either String UserInfo
decodeUserInfo (Response ByteString -> ByteString
forall body. Response body -> body
HTTP.responseBody Response ByteString
resp) of
    Left String
err -> Either CredentialFailure UserInfo
-> IO (Either CredentialFailure UserInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CredentialFailure UserInfo
 -> IO (Either CredentialFailure UserInfo))
-> (CredentialFailure -> Either CredentialFailure UserInfo)
-> CredentialFailure
-> IO (Either CredentialFailure UserInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CredentialFailure -> Either CredentialFailure UserInfo
forall a b. a -> Either a b
Left (CredentialFailure -> IO (Either CredentialFailure UserInfo))
-> CredentialFailure -> IO (Either CredentialFailure UserInfo)
forall a b. (a -> b) -> a -> b
$ URI -> Text -> CredentialFailure
FailedToFetchUserInfo URI
userInfoEndpoint (String -> Text
Text.pack String
err)
    Right UserInfo
userInfo -> Either CredentialFailure UserInfo
-> IO (Either CredentialFailure UserInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CredentialFailure UserInfo
 -> IO (Either CredentialFailure UserInfo))
-> (UserInfo -> Either CredentialFailure UserInfo)
-> UserInfo
-> IO (Either CredentialFailure UserInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UserInfo -> Either CredentialFailure UserInfo
forall a b. b -> Either a b
Right (UserInfo -> IO (Either CredentialFailure UserInfo))
-> UserInfo -> IO (Either CredentialFailure UserInfo)
forall a b. (a -> b) -> a -> b
$ UserInfo
userInfo

decodeUserInfo :: BL.ByteString -> Either String UserInfo
decodeUserInfo :: ByteString -> Either String UserInfo
decodeUserInfo ByteString
bs = do
  Value
obj <- ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
bs
  ((Value -> Parser UserInfo) -> Value -> Either String UserInfo)
-> Value -> (Value -> Parser UserInfo) -> Either String UserInfo
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Value -> Parser UserInfo) -> Value -> Either String UserInfo
forall a b. (a -> Parser b) -> a -> Either String b
Aeson.parseEither Value
obj ((Value -> Parser UserInfo) -> Either String UserInfo)
-> (Value -> Parser UserInfo) -> Either String UserInfo
forall a b. (a -> b) -> a -> b
$
    String -> (Object -> Parser UserInfo) -> Value -> Parser UserInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"UserInfo" ((Object -> Parser UserInfo) -> Value -> Parser UserInfo)
-> (Object -> Parser UserInfo) -> Value -> Parser UserInfo
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Text
userId <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"sub"
      Maybe Text
name <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Aeson..:? Key
"name"
      Text
handle <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"handle"
      pure
        UserInfo
          { Text
userId :: Text
$sel:userId:UserInfo :: Text
userId,
            Maybe Text
name :: Maybe Text
$sel:name:UserInfo :: Maybe Text
name,
            Text
handle :: Text
$sel:handle:UserInfo :: Text
handle
          }