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 type GargAPI =
 193
 194            -- Roots endpoint
 195                 "user"  :> Summary "First user endpoint"
 196                         :> Roots
 197
 198
 199            -- Node endpoint
 200            :<|> "node"  :> Summary "Node endpoint"
 201                         :> Capture "id" Int      :> NodeAPI
 202
 203
 204            -- Corpus endpoint
 205            :<|> "corpus":> Summary "Corpus endpoint"
 206                         :> Capture "id" Int      :> NodeAPI
 207
 208            -- Corpus endpoint
 209            :<|> "nodes" :> Summary "Nodes endpoint"
 210                         :> ReqBody '[JSON] [Int] :> NodesAPI
 211
 212         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
 213            -- Corpus endpoint
 214            :<|> "count" :> Summary "Count endpoint"
 215                         :> ReqBody '[JSON] Query :> CountAPI
 216
 217            -- Corpus endpoint
 218            :<|> "search":> Summary "Search endpoint"
 219                         :> ReqBody '[JSON] SearchQuery :> SearchAPI
 220
 221            :<|> "graph" :> Summary "Graph endpoint"
 222                         :> Capture "id" Int         :> GraphAPI
 223
 224            -- Tree endpoint
 225            :<|> "tree" :> Summary "Tree endpoint"
 226                        :> Capture "id" Int          :> TreeAPI
 227
 228
 229        --    :<|> "scraper" :> WithCallbacks ScraperAPI
 230
 231 -- /mv/<id>/<id>
 232 -- /merge/<id>/<id>
 233 -- /rename/<id>
 234        -- :<|> "static"
 235        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
 236        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
 237        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 238 ---------------------------------------------------------------------
 239 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 240
 241 type API = SwaggerFrontAPI :<|> GargAPI
 242
 243 ---------------------------------------------------------------------
 244 -- | Server declaration
 245 server :: Env -> IO (Server API)
 246 server env = do
 247   -- orchestrator <- scrapyOrchestrator env
 248   pure $ swaggerFront
 249      :<|> roots    conn
 250      :<|> nodeAPI  conn
 251      :<|> nodeAPI  conn
 252      :<|> nodesAPI conn
 253      :<|> count
 254      :<|> search   conn
 255      :<|> graphAPI conn
 256      :<|> treeAPI  conn
 257   --   :<|> orchestrator
 258   where
 259     conn = env ^. env_conn
 260
 261 ---------------------------------------------------------------------
 262 swaggerFront :: Server SwaggerFrontAPI
 263 swaggerFront = schemaUiServer swaggerDoc
 264            :<|> frontEndServer
 265
 266 gargMock :: Server GargAPI
 267 gargMock = mock apiGarg Proxy
 268
 269 ---------------------------------------------------------------------
 270 makeApp :: Env -> IO Application
 271 makeApp = fmap (serve api) . server
 272
 273 appMock :: Application
 274 appMock = serve api (swaggerFront :<|> gargMock)
 275
 276 ---------------------------------------------------------------------
 277 api :: Proxy API
 278 api  = Proxy
 279
 280 apiGarg :: Proxy GargAPI
 281 apiGarg  = Proxy
 282 ---------------------------------------------------------------------
 283
 284 schemaUiServer :: (Server api ~ Handler Swagger)
 285         => Swagger -> Server (SwaggerSchemaUI' dir api)
 286 schemaUiServer = swaggerSchemaUIServer
 287
 288
 289 -- Type Family for the Documentation
 290 type family TypeName (x :: *) :: Symbol where
 291     TypeName Int  = "Int"
 292     TypeName Text = "Text"
 293     TypeName x    = GenericTypeName x (Rep x ())
 294
 295 type family GenericTypeName t (r :: *) :: Symbol where
 296     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 297
 298 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 299
 300
 301 -- | Swagger Specifications
 302 swaggerDoc :: Swagger
 303 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 304   & info.title       .~ "Gargantext"
 305   & info.version     .~ "0.1.0"
 306   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 307   & info.description ?~ "REST API specifications"
 308   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 309   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 310                  ["Garg" & description ?~ "Main operations"]
 311   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 312     where
 313         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 314
 315 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 316 swaggerWriteJSON :: IO ()
 317 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 318
 319 portRouteInfo :: PortNumber -> IO ()
 320 portRouteInfo port = do
 321   T.putStrLn "      ----Main Routes-----      "
 322   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 323   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 324
 325 -- | startGargantext takes as parameters port number and Ini file.
 326 startGargantext :: PortNumber -> FilePath -> IO ()
 327 startGargantext port file = do
 328   env <- newEnv port file
 329   portRouteInfo port
 330   app <- makeDevApp env
 331   run port app
 332
 333 startGargantextMock :: PortNumber -> IO ()
 334 startGargantextMock port = do
 335   portRouteInfo port
 336   application <- makeMockApp . MockEnv $ FireWall False
 337   run port application
 338