module Unison.Auth.Discovery where

import Data.Aeson qualified as Aeson
import Data.Text qualified as Text
import Network.HTTP.Client qualified as HTTP
import Network.HTTP.Client.TLS qualified as HTTP
import Network.URI
import Unison.Auth.Types
import Unison.Prelude
import Unison.Share.Types (CodeserverURI (..), codeserverToURI)
import UnliftIO qualified

discoveryURIForCodeserver :: CodeserverURI -> URI
discoveryURIForCodeserver :: CodeserverURI -> URI
discoveryURIForCodeserver CodeserverURI
cs =
  let uri :: URI
uri = CodeserverURI -> URI
codeserverToURI CodeserverURI
cs
   in URI
uri {uriPath = uriPath uri <> "/.well-known/openid-configuration"}

fetchDiscoveryDoc :: (MonadIO m) => URI -> m (Either CredentialFailure DiscoveryDoc)
fetchDiscoveryDoc :: forall (m :: * -> *).
MonadIO m =>
URI -> m (Either CredentialFailure DiscoveryDoc)
fetchDiscoveryDoc URI
discoveryURI = IO (Either CredentialFailure DiscoveryDoc)
-> m (Either CredentialFailure DiscoveryDoc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either CredentialFailure DiscoveryDoc)
 -> m (Either CredentialFailure DiscoveryDoc))
-> (IO DiscoveryDoc -> IO (Either CredentialFailure DiscoveryDoc))
-> IO DiscoveryDoc
-> m (Either CredentialFailure DiscoveryDoc)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> m (Either e a)
UnliftIO.try @_ @CredentialFailure (IO DiscoveryDoc -> m (Either CredentialFailure DiscoveryDoc))
-> IO DiscoveryDoc -> m (Either CredentialFailure DiscoveryDoc)
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
discoveryURI
  Response ByteString
resp <- Request -> Manager -> IO (Response ByteString)
HTTP.httpLbs Request
req Manager
unauthenticatedHttpClient
  case ByteString -> Either String DiscoveryDoc
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode (Response ByteString -> ByteString
forall body. Response body -> body
HTTP.responseBody (Response ByteString -> ByteString)
-> Response ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Response ByteString
resp) of
    Left String
err -> CredentialFailure -> IO DiscoveryDoc
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
UnliftIO.throwIO (CredentialFailure -> IO DiscoveryDoc)
-> CredentialFailure -> IO DiscoveryDoc
forall a b. (a -> b) -> a -> b
$ URI -> Text -> CredentialFailure
InvalidDiscoveryDocument URI
discoveryURI (String -> Text
Text.pack String
err)
    Right DiscoveryDoc
doc -> DiscoveryDoc -> IO DiscoveryDoc
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiscoveryDoc
doc