src/Gargantext/API.hs

   1 {-|
   2 Module      : Gargantext.API
   3 Description : Server API
   4 Copyright   : (c) CNRS, 2017-Present
   5 License     : AGPL + CECILL v3
   6 Maintainer  : team@gargantext.org
   7 Stability   : experimental
   8 Portability : POSIX
   9
  10 Main REST API of Gargantext (both Server and Client sides)
  11
  12 TODO App type, the main monad in which the bot code is written with.
  13 Provide config, state, logs and IO
  14  type App m a =  ( MonadState AppState m
  15                  , MonadReader Conf m
  16                  , MonadLog (WithSeverity Doc) m
  17                  , MonadIO m) => m a
  18 Thanks @yannEsposito for this.
  19 -}
  20
  21 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  22
  23
  24 {-# LANGUAGE NoImplicitPrelude    #-}
  25 {-# LANGUAGE DataKinds            #-}
  26 {-# LANGUAGE DeriveGeneric        #-}
  27 {-# LANGUAGE FlexibleInstances    #-}
  28 {-# LANGUAGE OverloadedStrings    #-}
  29 {-# LANGUAGE TemplateHaskell      #-}
  30 {-# LANGUAGE TypeOperators        #-}
  31 {-# LANGUAGE KindSignatures       #-}
  32 {-# LANGUAGE TypeFamilies         #-}
  33 {-# LANGUAGE UndecidableInstances #-}
  34
  35 ---------------------------------------------------------------------
  36 module Gargantext.API
  37       where
  38 ---------------------------------------------------------------------
  39 import           Gargantext.Prelude
  40
  41 import           System.IO (FilePath)
  42
  43 import           GHC.Generics (D1, Meta (..), Rep)
  44 import           GHC.TypeLits (AppendSymbol, Symbol)
  45
  46 import           Control.Lens
  47 import           Data.Aeson.Encode.Pretty (encodePretty)
  48 import qualified Data.ByteString.Lazy.Char8 as BL8
  49 import           Data.Swagger
  50 import           Data.Text (Text)
  51 import qualified Data.Text.IO as T
  52 --import qualified Data.Set as Set
  53
  54 import           Network.Wai
  55 import           Network.Wai.Handler.Warp hiding (defaultSettings)
  56
  57 import           Servant
  58 import           Servant.Mock (mock)
  59 --import           Servant.Job.Server (WithCallbacks)
  60 import           Servant.Swagger
  61 import           Servant.Swagger.UI
  62 -- import Servant.API.Stream
  63
  64 --import Gargantext.API.Swagger
  65 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
  66
  67 import Gargantext.API.Node ( Roots    , roots
  68                            , NodeAPI  , nodeAPI
  69                            , NodesAPI , nodesAPI
  70                            )
  71 import Gargantext.API.Count  ( CountAPI, count, Query)
  72 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
  73 --import Gargantext.API.Orchestrator
  74 --import Gargantext.API.Orchestrator.Types
  75
  76 ---------------------------------------------------------------------
  77
  78 import GHC.Base (Applicative)
  79 -- import Control.Lens
  80
  81 import Data.List (lookup)
  82 import Data.Text.Encoding (encodeUtf8)
  83
  84 --import Network.Wai (Request, requestHeaders, responseLBS)
  85 import Network.Wai (Request, requestHeaders)
  86 --import qualified Network.Wai.Handler.Warp as Warp
  87 import Network.Wai.Middleware.Cors
  88
  89 import Network.Wai.Middleware.RequestLogger
  90 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
  91
  92 import Network.HTTP.Types hiding (Query)
  93
  94
  95 import Gargantext.API.Settings
  96
  97 fireWall :: Applicative f => Request -> FireWall -> f Bool
  98 fireWall req fw = do
  99     let origin = lookup "Origin" (requestHeaders req)
 100     let host   = lookup "Host"   (requestHeaders req)
 101
 102     let hostOk   = Just (encodeUtf8 "localhost:3000")
 103     let originOk = Just (encodeUtf8 "http://localhost:8008")
 104
 105     if  origin == originOk
 106        && host == hostOk
 107        || (not $ unFireWall fw)
 108
 109        then pure True
 110        else pure False
 111
 112
 113 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
 114 makeMockApp :: MockEnv -> IO Application
 115 makeMockApp env = do
 116     let serverApp = appMock
 117
 118     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 119     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 120     let checkOriginAndHost app req resp = do
 121             blocking <- fireWall req (env ^. menv_firewall)
 122             case blocking  of
 123                 True  -> app req resp
 124                 False -> resp ( responseLBS status401 []
 125                               "Invalid Origin or Host header")
 126
 127     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 128 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 129             { corsOrigins        = Nothing --  == /*
 130             , corsMethods        = [ methodGet   , methodPost   , methodPut
 131                                    , methodDelete, methodOptions, methodHead]
 132             , corsRequestHeaders = ["authorization", "content-type"]
 133             , corsExposedHeaders = Nothing
 134             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 135             , corsVaryOrigin     = False
 136             , corsRequireOrigin  = False
 137             , corsIgnoreFailures = False
 138             }
 139
 140     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 141     --          $ Warp.defaultSettings
 142
 143     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 144     pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
 145
 146
 147 --
 148 makeDevApp :: Env -> IO Application
 149 makeDevApp env = do
 150     serverApp <- makeApp env
 151
 152     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 153     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 154 --    let checkOriginAndHost app req resp = do
 155 --            blocking <- fireWall req (env ^. menv_firewall)
 156 --            case blocking  of
 157 --                True  -> app req resp
 158 --                False -> resp ( responseLBS status401 []
 159 --                              "Invalid Origin or Host header")
 160 --
 161     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 162 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 163             { corsOrigins        = Nothing --  == /*
 164             , corsMethods        = [ methodGet   , methodPost   , methodPut
 165                                    , methodDelete, methodOptions, methodHead]
 166             , corsRequestHeaders = ["authorization", "content-type"]
 167             , corsExposedHeaders = Nothing
 168             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 169             , corsVaryOrigin     = False
 170             , corsRequireOrigin  = False
 171             , corsIgnoreFailures = False
 172             }
 173
 174     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 175     --          $ Warp.defaultSettings
 176
 177     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 178     pure $ logStdoutDev $ corsMiddleware $ serverApp
 179
 180 --
 181
 182 ---------------------------------------------------------------------
 183 -- | API Global
 184
 185 -- | API for serving @swagger.json@
 186 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
 187
 188 -- | API for serving main operational routes of @gargantext.org@
 189 type GargAPI =  "user"  :> Summary "First user endpoint"
 190                         :> Roots
 191
 192            :<|> "node"  :> Summary "Node endpoint"
 193                         :> Capture "id" Int      :> NodeAPI
 194
 195            :<|> "corpus":> Summary "Corpus endpoint"
 196                         :> Capture "id" Int      :> NodeAPI
 197
 198            :<|> "nodes" :> Summary "Nodes endpoint"
 199                         :> ReqBody '[JSON] [Int] :> NodesAPI
 200
 201        -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
 202            :<|> "count" :> Summary "Count endpoint"
 203                         :> ReqBody '[JSON] Query :> CountAPI
 204
 205            :<|> "search":> Summary "Search endpoint"
 206                         :> ReqBody '[JSON] SearchQuery :> SearchAPI
 207
 208        --    :<|> "scraper" :> WithCallbacks ScraperAPI
 209
 210 -- /mv/<id>/<id>
 211 -- /merge/<id>/<id>
 212 -- /rename/<id>
 213        -- :<|> "static"
 214        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
 215        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
 216        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 217 ---------------------------------------------------------------------
 218 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 219
 220 type API = SwaggerFrontAPI :<|> GargAPI
 221
 222 ---------------------------------------------------------------------
 223 -- | Server declaration
 224 server :: Env -> IO (Server API)
 225 server env = do
 226   -- orchestrator <- scrapyOrchestrator env
 227   pure $ swaggerFront
 228      :<|> roots    conn
 229      :<|> nodeAPI  conn
 230      :<|> nodeAPI  conn
 231      :<|> nodesAPI conn
 232      :<|> count
 233      :<|> search conn
 234   --   :<|> orchestrator
 235   where
 236     conn = env ^. env_conn
 237
 238 ---------------------------------------------------------------------
 239 swaggerFront :: Server SwaggerFrontAPI
 240 swaggerFront = schemaUiServer swaggerDoc
 241            :<|> frontEndServer
 242
 243 gargMock :: Server GargAPI
 244 gargMock = mock apiGarg Proxy
 245
 246 ---------------------------------------------------------------------
 247 makeApp :: Env -> IO Application
 248 makeApp = fmap (serve api) . server
 249
 250 appMock :: Application
 251 appMock = serve api (swaggerFront :<|> gargMock)
 252
 253 ---------------------------------------------------------------------
 254 api :: Proxy API
 255 api  = Proxy
 256
 257 apiGarg :: Proxy GargAPI
 258 apiGarg  = Proxy
 259 ---------------------------------------------------------------------
 260
 261 schemaUiServer :: (Server api ~ Handler Swagger)
 262         => Swagger -> Server (SwaggerSchemaUI' dir api)
 263 schemaUiServer = swaggerSchemaUIServer
 264
 265
 266 -- Type Family for the Documentation
 267 type family TypeName (x :: *) :: Symbol where
 268     TypeName Int  = "Int"
 269     TypeName Text = "Text"
 270     TypeName x    = GenericTypeName x (Rep x ())
 271
 272 type family GenericTypeName t (r :: *) :: Symbol where
 273     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 274
 275 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 276
 277
 278 -- | Swagger Specifications
 279 swaggerDoc :: Swagger
 280 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 281   & info.title       .~ "Gargantext"
 282   & info.version     .~ "0.1.0"
 283   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 284   & info.description ?~ "REST API specifications"
 285   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 286   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 287                  ["Garg" & description ?~ "Main operations"]
 288   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 289     where
 290         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 291
 292 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 293 swaggerWriteJSON :: IO ()
 294 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 295
 296 portRouteInfo :: PortNumber -> IO ()
 297 portRouteInfo port = do
 298   T.putStrLn "      ----Main Routes-----      "
 299   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 300   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 301
 302 -- | startGargantext takes as parameters port number and Ini file.
 303 startGargantext :: PortNumber -> FilePath -> IO ()
 304 startGargantext port file = do
 305   env <- newEnv port file
 306   portRouteInfo port
 307   app <- makeDevApp env
 308   run port app
 309
 310 startGargantextMock :: PortNumber -> IO ()
 311 startGargantextMock port = do
 312   portRouteInfo port
 313   application <- makeMockApp . MockEnv $ FireWall False
 314   run port application
 315