src/Gargantext/API.hs

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