{-# LANGUAGE DataKinds #-}

module Hercules.Frontend where

import qualified Data.Text as T
import Hercules.API.Accounts.Account (Account)
import Hercules.API.Prelude
import Hercules.API.Projects.Project (Project)
import Hercules.API.SourceHostingSite.SourceHostingSite
  ( SourceHostingSite,
  )
import Network.URI
import Servant.API
import Servant.API.Generic
import Servant.Links

-- | URL routes for the web interface.
--
-- Typically the base URL for this is https://hercules-ci.com
data FrontendRoutes view f = FrontendRoutes
  { FrontendRoutes view f -> f :- view
home ::
      f
        :- view,
    FrontendRoutes view f
-> f
   :- (Capture' '[Required, Strict] "site" (Name SourceHostingSite)
       :> (Capture' '[Required, Strict] "account" (Name Account) :> view))
account ::
      f
        :- Capture' [Required, Strict] "site" (Name SourceHostingSite)
        :> Capture' [Required, Strict] "account" (Name Account)
        :> view,
    FrontendRoutes view f
-> f
   :- ("settings"
       :> ("cli"
           :> ("authorize"
               :> (QueryParam' '[Required, Strict] "token" Text :> view))))
cliAuthorize ::
      f :- "settings" :> "cli" :> "authorize"
        :> QueryParam' [Required, Strict] "token" Text
        :> view,
    FrontendRoutes view f
-> f
   :- (Capture' '[Required, Strict] "site" (Name SourceHostingSite)
       :> (Capture' '[Required, Strict] "account" (Name Account)
           :> (Capture' '[Required, Strict] "project" (Name Project)
               :> view)))
project ::
      f
        :- Capture' [Required, Strict] "site" (Name SourceHostingSite)
        :> Capture' [Required, Strict] "account" (Name Account)
        :> Capture' [Required, Strict] "project" (Name Project)
        :> view,
    FrontendRoutes view f
-> f
   :- (Capture' '[Required, Strict] "site" (Name SourceHostingSite)
       :> (Capture' '[Required, Strict] "account" (Name Account)
           :> (Capture' '[Required, Strict] "project" (Name Project)
               :> ("jobs"
                   :> (Capture' '[Required, Strict] "jobIndex" Int :> view)))))
job ::
      f
        :- Capture' [Required, Strict] "site" (Name SourceHostingSite)
        :> Capture' [Required, Strict] "account" (Name Account)
        :> Capture' [Required, Strict] "project" (Name Project)
        :> "jobs"
        :> Capture' [Required, Strict] "jobIndex" Int
        :> view
  }
  deriving ((forall x. FrontendRoutes view f -> Rep (FrontendRoutes view f) x)
-> (forall x.
    Rep (FrontendRoutes view f) x -> FrontendRoutes view f)
-> Generic (FrontendRoutes view f)
forall x. Rep (FrontendRoutes view f) x -> FrontendRoutes view f
forall x. FrontendRoutes view f -> Rep (FrontendRoutes view f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall view f x.
Rep (FrontendRoutes view f) x -> FrontendRoutes view f
forall view f x.
FrontendRoutes view f -> Rep (FrontendRoutes view f) x
$cto :: forall view f x.
Rep (FrontendRoutes view f) x -> FrontendRoutes view f
$cfrom :: forall view f x.
FrontendRoutes view f -> Rep (FrontendRoutes view f) x
Generic)

mkLinks :: URI -> FrontendRoutes Raw (AsLink Text)
mkLinks :: URI -> FrontendRoutes Raw (AsLink Text)
mkLinks URI
base = (Link -> Text) -> FrontendRoutes Raw (AsLink Text)
forall (routes :: * -> *) a.
(HasLink (ToServantApi routes), GenericServant routes (AsLink a),
 ToServant routes (AsLink a) ~ MkLink (ToServantApi routes) a) =>
(Link -> a) -> routes (AsLink a)
allFieldLinks' ((Link -> Text) -> FrontendRoutes Raw (AsLink Text))
-> (Link -> Text) -> FrontendRoutes Raw (AsLink Text)
forall a b. (a -> b) -> a -> b
$
  \Link
link -> ShowS -> Text
shows2Text (ShowS -> Text) -> ShowS -> Text
forall a b. (a -> b) -> a -> b
$ ShowS -> URI -> ShowS
uriToString ShowS
forall a. a -> a
id (URI -> ShowS) -> URI -> ShowS
forall a b. (a -> b) -> a -> b
$ Link -> URI
linkURI Link
link URI -> URI -> URI
`relativeTo` URI
base
  where
    shows2Text :: ShowS -> Text
    shows2Text :: ShowS -> Text
shows2Text = String -> Text
T.pack (String -> Text) -> (ShowS -> String) -> ShowS -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"")

herculesLinks :: FrontendRoutes Raw (AsLink Text)
herculesLinks :: FrontendRoutes Raw (AsLink Text)
herculesLinks = URI -> FrontendRoutes Raw (AsLink Text)
mkLinks URI
base
  where
    base :: URI
    base :: URI
base =
      URI :: String -> Maybe URIAuth -> String -> String -> String -> URI
URI
        { uriPath :: String
uriPath = String
"",
          uriQuery :: String
uriQuery = String
"",
          uriFragment :: String
uriFragment = String
"",
          uriScheme :: String
uriScheme = String
"https:",
          uriAuthority :: Maybe URIAuth
uriAuthority =
            URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just
              URIAuth :: String -> String -> String -> URIAuth
URIAuth
                { uriUserInfo :: String
uriUserInfo = String
"",
                  uriRegName :: String
uriRegName = String
"hercules-ci.com",
                  uriPort :: String
uriPort = String
""
                }
        }