module Mensam.Server.Server.Route.Api.OpenApi where

import Mensam.API.Route.Api qualified as Route.Api
import Mensam.API.Route.Api.OpenApi
import Mensam.Server.Application.Configured.Class
import Mensam.Server.Configuration
import Mensam.Server.OpenApi qualified

import Control.Lens
import Data.List qualified as L
import Data.OpenApi
import Data.Text qualified as T
import Servant.Links
import Servant.Server.Generic

handler ::
  MonadConfigured m =>
  Routes (AsServerT m)
handler :: forall (m :: * -> *). MonadConfigured m => Routes (AsServerT m)
handler =
  Routes
    { routeJson :: AsServerT m
:- (Summary "OpenAPI"
    :> (Description
          "This OpenAPI specification is automatically generated from a servant API.\n"
        :> ("openapi" :> Get '[JSON] OpenApi)))
routeJson = m OpenApi
AsServerT m
:- (Summary "OpenAPI"
    :> (Description
          "This OpenAPI specification is automatically generated from a servant API.\n"
        :> ("openapi" :> Get '[JSON] OpenApi)))
forall (m :: * -> *). MonadConfigured m => m OpenApi
specification
    }

specification :: MonadConfigured m => m OpenApi
specification :: forall (m :: * -> *). MonadConfigured m => m OpenApi
specification = do
  Configuration
config <- m Configuration
forall (m :: * -> *). MonadConfigured m => m Configuration
configuration
  let
    addVersion :: OpenApi -> OpenApi
    addVersion :: OpenApi -> OpenApi
addVersion =
      case Configuration -> Maybe Text
configRevision Configuration
config of
        Just Text
revision -> (Info -> Identity Info) -> OpenApi -> Identity OpenApi
forall s a. HasInfo s a => Lens' s a
Lens' OpenApi Info
info ((Info -> Identity Info) -> OpenApi -> Identity OpenApi)
-> ((Text -> Identity Text) -> Info -> Identity Info)
-> (Text -> Identity Text)
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity Text) -> Info -> Identity Info
forall s a. HasVersion s a => Lens' s a
Lens' Info Text
version ((Text -> Identity Text) -> OpenApi -> Identity OpenApi)
-> Text -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
revision
        Maybe Text
Nothing -> OpenApi -> OpenApi
forall a. a -> a
id
    addServer :: OpenApi -> OpenApi
    addServer :: OpenApi -> OpenApi
addServer = ([Server] -> Identity [Server]) -> OpenApi -> Identity OpenApi
forall s a. HasServers s a => Lens' s a
Lens' OpenApi [Server]
servers (([Server] -> Identity [Server]) -> OpenApi -> Identity OpenApi)
-> [Server] -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [Server
relativeServer]
     where
      relativeServer :: Server
relativeServer =
        Server
          { _serverUrl :: Text
_serverUrl = [Char] -> Text
T.pack [Char]
relativePath
          , _serverDescription :: Maybe Text
_serverDescription = Maybe Text
forall a. Maybe a
Nothing
          , _serverVariables :: InsOrdHashMap Text ServerVariable
_serverVariables = InsOrdHashMap Text ServerVariable
forall a. Monoid a => a
mempty
          }
      linkCurrent :: AsLink Link
:- (Summary "OpenAPI"
    :> (Description
          "This OpenAPI specification is automatically generated from a servant API.\n"
        :> ("openapi" :> Get '[JSON] OpenApi)))
linkCurrent = Routes (AsLink Link)
-> AsLink Link
   :- (Summary "OpenAPI"
       :> (Description
             "This OpenAPI specification is automatically generated from a servant API.\n"
           :> ("openapi" :> Get '[JSON] OpenApi)))
forall route.
Routes route
-> route
   :- (Summary "OpenAPI"
       :> (Description
             "This OpenAPI specification is automatically generated from a servant API.\n"
           :> ("openapi" :> Get '[JSON] OpenApi)))
routeJson (Routes (AsLink Link)
 -> AsLink Link
    :- (Summary "OpenAPI"
        :> (Description
              "This OpenAPI specification is automatically generated from a servant API.\n"
            :> ("openapi" :> Get '[JSON] OpenApi))))
-> (Routes (AsLink Link) -> Routes (AsLink Link))
-> Routes (AsLink Link)
-> AsLink Link
   :- (Summary "OpenAPI"
       :> (Description
             "This OpenAPI specification is automatically generated from a servant API.\n"
           :> ("openapi" :> Get '[JSON] OpenApi)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Routes (AsLink Link) -> AsLink Link :- NamedRoutes Routes
Routes (AsLink Link) -> Routes (AsLink Link)
forall route. Routes route -> route :- NamedRoutes Routes
Route.Api.routeOpenApi (Routes (AsLink Link)
 -> AsLink Link
    :- (Summary "OpenAPI"
        :> (Description
              "This OpenAPI specification is automatically generated from a servant API.\n"
            :> ("openapi" :> Get '[JSON] OpenApi))))
-> Routes (AsLink Link)
-> AsLink Link
   :- (Summary "OpenAPI"
       :> (Description
             "This OpenAPI specification is automatically generated from a servant API.\n"
           :> ("openapi" :> Get '[JSON] OpenApi)))
forall a b. (a -> b) -> a -> b
$ Routes (AsLink Link)
forall (routes :: * -> *).
(HasLink (ToServantApi routes),
 GenericServant routes (AsLink Link),
 ToServant routes (AsLink Link)
 ~ MkLink (ToServantApi routes) Link) =>
routes (AsLink Link)
allFieldLinks
      relativePath :: [Char]
relativePath = Link -> [Char]
relativePathGoBack Link
linkCurrent
    addDescription :: OpenApi -> OpenApi
    addDescription :: OpenApi -> OpenApi
addDescription =
      (Info -> Identity Info) -> OpenApi -> Identity OpenApi
forall s a. HasInfo s a => Lens' s a
Lens' OpenApi Info
info ((Info -> Identity Info) -> OpenApi -> Identity OpenApi)
-> ((Maybe Text -> Identity (Maybe Text)) -> Info -> Identity Info)
-> (Maybe Text -> Identity (Maybe Text))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Identity (Maybe Text)) -> Info -> Identity Info
forall s a. HasDescription s a => Lens' s a
Lens' Info (Maybe Text)
description
        ((Maybe Text -> Identity (Maybe Text))
 -> OpenApi -> Identity OpenApi)
-> Text -> OpenApi -> OpenApi
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ [Text] -> Text
T.concat
          [ Text
"This is the API for Mensam Desk-Booking.\n\
            \\n\
            \- [User Interface](..)\n"
          , case Configuration -> Maybe Text
configSourceUrl Configuration
config of
              Maybe Text
Nothing -> Text
""
              Just Text
sourceUrl -> Text
"- [GitHub](" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
sourceUrl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")\n"
          , Text
"- [OpenAPI]()\n\
            \- [Haddock (server source)](./haddock/index.html)\n\
            \\n"
          ]
  OpenApi -> m OpenApi
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OpenApi -> m OpenApi) -> OpenApi -> m OpenApi
forall a b. (a -> b) -> a -> b
$
    OpenApi
Mensam.Server.OpenApi.openapi
      OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Info -> Identity Info) -> OpenApi -> Identity OpenApi
forall s a. HasInfo s a => Lens' s a
Lens' OpenApi Info
info ((Info -> Identity Info) -> OpenApi -> Identity OpenApi)
-> ((Text -> Identity Text) -> Info -> Identity Info)
-> (Text -> Identity Text)
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Identity Text) -> Info -> Identity Info
forall s a. HasTitle s a => Lens' s a
Lens' Info Text
title ((Text -> Identity Text) -> OpenApi -> Identity OpenApi)
-> Text -> OpenApi -> OpenApi
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Text
"Mensam API"
      OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& OpenApi -> OpenApi
addVersion
      OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& (Info -> Identity Info) -> OpenApi -> Identity OpenApi
forall s a. HasInfo s a => Lens' s a
Lens' OpenApi Info
info ((Info -> Identity Info) -> OpenApi -> Identity OpenApi)
-> ((Maybe License -> Identity (Maybe License))
    -> Info -> Identity Info)
-> (Maybe License -> Identity (Maybe License))
-> OpenApi
-> Identity OpenApi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe License -> Identity (Maybe License))
-> Info -> Identity Info
forall s a. HasLicense s a => Lens' s a
Lens' Info (Maybe License)
license ((Maybe License -> Identity (Maybe License))
 -> OpenApi -> Identity OpenApi)
-> License -> OpenApi -> OpenApi
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ License
"GNU Affero General Public License v3.0"
      OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& OpenApi -> OpenApi
addDescription
      OpenApi -> (OpenApi -> OpenApi) -> OpenApi
forall a b. a -> (a -> b) -> b
& OpenApi -> OpenApi
addServer

-- | Assuming that the origin link doesn't have a trailing slash.
relativePathGoBack :: Servant.Links.Link -> String
relativePathGoBack :: Link -> [Char]
relativePathGoBack Link
origin =
  case Link -> [[Char]]
linkSegments Link
origin of
    [] -> [Char]
""
    [[Char]
_] -> [Char]
""
    [Char]
_ : [[Char]]
baseSegments -> [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
L.intercalate [Char]
"/" ([Char]
".." [Char] -> [[Char]] -> [[Char]]
forall a b. a -> [b] -> [a]
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ [[Char]]
baseSegments)