1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
{-|
Module : Gargantext.API.Server
Description : REST API declaration
Copyright : (c) CNRS, 2017-Present
License : AGPL + CECILL v3
Maintainer : team@gargantext.org
Stability : experimental
Portability : POSIX
-}
{-# LANGUAGE MonoLocalBinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
---------------------------------------------------------------------
module Gargantext.API.Server where
---------------------------------------------------------------------
import Control.Lens ((^.))
import Control.Monad.Except (withExceptT)
import Control.Monad.Reader (runReaderT)
import Data.Aeson
import Data.Text (Text)
import Data.Version (showVersion)
import Servant
import Servant.Swagger.UI (swaggerSchemaUIServer)
import qualified Data.ByteString.Lazy.Char8 as BL8
import qualified Paths_gargantext as PG -- cabal magic build module
import qualified Gargantext.API.Public as Public
import Gargantext.API.Admin.Auth.Types (AuthContext)
import Gargantext.API.Admin.Auth (auth)
import Gargantext.API.Admin.FrontEnd (frontEndServer)
import qualified Gargantext.API.GraphQL as GraphQL
import Gargantext.API.Prelude
import Gargantext.API.Routes
import Gargantext.API.Swagger (swaggerDoc)
import Gargantext.API.ThrowAll (serverPrivateGargAPI)
import Gargantext.Database.Query.Table.Node.Error (NodeError(..))
import Gargantext.Database.Prelude (hasConfig)
import Gargantext.Prelude
import Gargantext.Prelude.Config (gc_url_backend_api)
serverGargAPI :: ToJSON err => Text -> GargServerM env err GargAPI
serverGargAPI baseUrl -- orchestrator
= auth
:<|> gargVersion
:<|> serverPrivateGargAPI
:<|> Public.api baseUrl
-- :<|> orchestrator
where
gargVersion :: GargServer GargVersion
gargVersion = pure (cs $ showVersion PG.version)
-- | Server declarations
server :: forall env. (Typeable env, EnvC env) => env -> IO (Server API)
server env = do
-- orchestrator <- scrapyOrchestrator env
pure $ swaggerSchemaUIServer swaggerDoc
:<|> hoistServerWithContext
(Proxy :: Proxy GargAPI)
(Proxy :: Proxy AuthContext)
transform
(serverGargAPI (env ^. hasConfig . gc_url_backend_api))
:<|> hoistServerWithContext
(Proxy :: Proxy GraphQL.API)
(Proxy :: Proxy AuthContext)
transform
GraphQL.api
:<|> frontEndServer
where
transform :: forall a. GargM env GargError a -> Handler a
transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
showAsServantErr :: GargError -> ServerError
showAsServantErr (GargNodeError err@NoListFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@NoRootFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@NoCorpusFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@NoUserFound) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargNodeError err@(DoesNotExist _)) = err404 { errBody = BL8.pack $ show err }
showAsServantErr (GargServerError err) = err
showAsServantErr a = err500 { errBody = BL8.pack $ show a }