-- SPDX-FileCopyrightText: 2022 Gregor Kleen <gregor.kleen@ifi.lmu.de>
--
-- SPDX-License-Identifier: AGPL-3.0-or-later

module Utils.Approot
  ( approotScopeHost, approotScopeBaseUrl, approotScopeHost'
  , approotRender
  ) where

import ClassyPrelude.Yesod hiding (Proxy)
import Settings

import Utils.Route

import Network.URI (URI(URI), URIAuth(URIAuth))
import qualified Network.URI as URI

import Control.Lens

import Data.Proxy


approotScopeHost' :: HasAppSettings site => (URI -> URIAuth -> a) -> ApprootScope -> site -> Maybe a
approotScopeHost' f rApproot app = do
  approotText <- views _appRoot ($ rApproot) app
  approotURI <- URI.parseURI $ unpack approotText
  approotAuthority <- URI.uriAuthority approotURI
  return $ f approotURI approotAuthority

approotScopeHost :: HasAppSettings site => ApprootScope -> site -> Maybe ByteString
approotScopeHost = approotScopeHost' $ \_ URIAuth{..}
  -> encodeUtf8 . pack $ uriRegName <> uriPort

approotScopeBaseUrl :: HasAppSettings site => ApprootScope -> site -> Maybe Text
approotScopeBaseUrl = approotScopeHost' $ \URI{..} URIAuth{..}
  -> pack $ uriScheme <> "//" <> uriRegName <> uriPort

approotRender :: forall url m.
                 ( HasAppSettings (HandlerSite m)
                 , MonadHandler m
                 , Yesod (HandlerSite m)
                 , HasRoute (HandlerSite m) url
                 )
              => ApprootScope -> url -> m Text 
approotRender rApproot route = do
  app <- getYesod
  approotHost <- maybe (getApprootText approot app <$> waiRequest) return $ approotScopeBaseUrl rApproot app
  return . yesodRender app approotHost (urlRoute route) . withLens (urlRouteParams (Proxy @(HandlerSite m))) $ \g _ -> g route