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 {-# 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
  40 import           Database.PostgreSQL.Simple (Connection)
  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 Control.Monad.IO.Class (liftIO)
  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.HTML.Blaze (HTML)
  60 import           Servant.Mock (mock)
  61 --import           Servant.Job.Server (WithCallbacks)
  62 import           Servant.Static.TH.Internal.Server (fileTreeToServer)
  63 import           Servant.Static.TH.Internal.FileTree (fileTypeToFileTree, FileType(FileTypeFile))
  64 import           Servant.Swagger
  65 import           Servant.Swagger.UI
  66 -- import Servant.API.Stream
  67 import           Text.Blaze.Html (Html)
  68
  69 --import Gargantext.API.Swagger
  70 import Gargantext.Prelude
  71 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
  72
  73 import Gargantext.API.Auth (AuthRequest, AuthResponse, auth')
  74 import Gargantext.API.Node ( Roots    , roots
  75                            , NodeAPI  , nodeAPI
  76                            , NodesAPI , nodesAPI
  77                            , GraphAPI , graphAPI
  78                            , TreeAPI  , treeAPI
  79                            , HyperdataAny
  80                            , HyperdataCorpus
  81                            , HyperdataAnnuaire
  82                            )
  83 import Gargantext.Database.Types.Node ()
  84 import Gargantext.API.Count  ( CountAPI, count, Query)
  85 import Gargantext.API.Search ( SearchAPI, search, SearchQuery)
  86
  87 --import Gargantext.API.Orchestrator
  88 --import Gargantext.API.Orchestrator.Types
  89
  90 ---------------------------------------------------------------------
  91
  92 import GHC.Base (Applicative)
  93 -- import Control.Lens
  94
  95 import Data.List (lookup)
  96 import Data.Text.Encoding (encodeUtf8)
  97
  98 --import Network.Wai (Request, requestHeaders, responseLBS)
  99 import Network.Wai (Request, requestHeaders)
 100 --import qualified Network.Wai.Handler.Warp as Warp
 101 import Network.Wai.Middleware.Cors
 102
 103 import Network.Wai.Middleware.RequestLogger
 104 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
 105
 106 import Network.HTTP.Types hiding (Query)
 107
 108
 109 import Gargantext.API.Settings
 110
 111 fireWall :: Applicative f => Request -> FireWall -> f Bool
 112 fireWall req fw = do
 113     let origin = lookup "Origin" (requestHeaders req)
 114     let host   = lookup "Host"   (requestHeaders req)
 115
 116     let hostOk   = Just (encodeUtf8 "localhost:3000")
 117     let originOk = Just (encodeUtf8 "http://localhost:8008")
 118
 119     if  origin == originOk
 120        && host == hostOk
 121        || (not $ unFireWall fw)
 122
 123        then pure True
 124        else pure False
 125
 126
 127 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
 128 makeMockApp :: MockEnv -> IO Application
 129 makeMockApp env = do
 130     let serverApp = appMock
 131
 132     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 133     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 134     let checkOriginAndHost app req resp = do
 135             blocking <- fireWall req (env ^. menv_firewall)
 136             case blocking  of
 137                 True  -> app req resp
 138                 False -> resp ( responseLBS status401 []
 139                               "Invalid Origin or Host header")
 140
 141     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 142 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 143             { corsOrigins        = Nothing --  == /*
 144             , corsMethods        = [ methodGet   , methodPost   , methodPut
 145                                    , methodDelete, methodOptions, methodHead]
 146             , corsRequestHeaders = ["authorization", "content-type"]
 147             , corsExposedHeaders = Nothing
 148             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 149             , corsVaryOrigin     = False
 150             , corsRequireOrigin  = False
 151             , corsIgnoreFailures = False
 152             }
 153
 154     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 155     --          $ Warp.defaultSettings
 156
 157     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 158     pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
 159
 160
 161
 162 makeDevApp :: Env -> IO Application
 163 makeDevApp env = do
 164     serverApp <- makeApp env
 165
 166     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 167     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 168 --    let checkOriginAndHost app req resp = do
 169 --            blocking <- fireWall req (env ^. menv_firewall)
 170 --            case blocking  of
 171 --                True  -> app req resp
 172 --                False -> resp ( responseLBS status401 []
 173 --                              "Invalid Origin or Host header")
 174 --
 175     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 176 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 177             { corsOrigins        = Nothing --  == /*
 178             , corsMethods        = [ methodGet   , methodPost   , methodPut
 179                                    , methodDelete, methodOptions, methodHead]
 180             , corsRequestHeaders = ["authorization", "content-type"]
 181             , corsExposedHeaders = Nothing
 182             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 183             , corsVaryOrigin     = False
 184             , corsRequireOrigin  = False
 185             , corsIgnoreFailures = False
 186             }
 187
 188     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 189     --          $ Warp.defaultSettings
 190
 191     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 192     pure $ logStdoutDev $ corsMiddleware $ serverApp
 193
 194 ---------------------------------------------------------------------
 195 -- | API Global
 196
 197 -- | API for serving @swagger.json@
 198 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
 199
 200 -- | API for serving main operational routes of @gargantext.org@
 201
 202
 203 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 204 -- | TODO          :<|> Summary "Latest API" :> GargAPI'
 205
 206
 207 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
 208
 209 auth :: Connection -> AuthRequest -> Handler AuthResponse
 210 auth conn ar = liftIO $ auth' conn ar
 211
 212 type GargAPI' =
 213            -- Auth endpoint
 214                 "auth"  :> Summary "AUTH API"
 215                         :> ReqBody '[JSON] AuthRequest
 216                         :> Post    '[JSON] AuthResponse
 217
 218            -- Roots endpoint
 219           :<|>  "user"  :> Summary "First user endpoint"
 220                         :> Roots
 221
 222            -- Node endpoint
 223            :<|> "node"  :> Summary "Node endpoint"
 224                         :> Capture "id" Int      :> NodeAPI HyperdataAny
 225
 226            -- Corpus endpoint
 227            :<|> "corpus":> Summary "Corpus endpoint"
 228                         :> Capture "id" Int      :> NodeAPI HyperdataCorpus
 229
 230            -- Annuaire endpoint
 231            :<|> "annuaire":> Summary "Annuaire endpoint"
 232                           :> Capture "id" Int      :> NodeAPI HyperdataAnnuaire
 233
 234            -- Corpus endpoint
 235            :<|> "nodes" :> Summary "Nodes endpoint"
 236                         :> ReqBody '[JSON] [Int] :> NodesAPI
 237
 238         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
 239            -- Corpus endpoint
 240            :<|> "count" :> Summary "Count endpoint"
 241                         :> ReqBody '[JSON] Query :> CountAPI
 242
 243            -- Corpus endpoint
 244            :<|> "search":> Summary "Search endpoint"
 245                         :> ReqBody '[JSON] SearchQuery :> SearchAPI
 246
 247            :<|> "graph" :> Summary "Graph endpoint"
 248                         :> Capture "id" Int         :> GraphAPI
 249
 250            -- Tree endpoint
 251            :<|> "tree" :> Summary "Tree endpoint"
 252                        :> Capture "id" Int          :> TreeAPI
 253
 254
 255        --    :<|> "scraper" :> WithCallbacks ScraperAPI
 256
 257 -- /mv/<id>/<id>
 258 -- /merge/<id>/<id>
 259 -- /rename/<id>
 260        -- :<|> "static"
 261        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
 262        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
 263        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 264 ---------------------------------------------------------------------
 265 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 266
 267 type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
 268
 269 ---------------------------------------------------------------------
 270 -- | Server declarations
 271
 272 server :: Env -> IO (Server API)
 273 server env = do
 274   gargAPI <- serverGargAPI env
 275   pure $  swaggerFront
 276      :<|> gargAPI
 277      :<|> serverIndex
 278
 279 serverGargAPI :: Env -> IO (Server GargAPI)
 280 serverGargAPI env = do
 281   -- orchestrator <- scrapyOrchestrator env
 282   pure $  auth     conn
 283      :<|> roots    conn
 284      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataAny)
 285      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataCorpus)
 286      :<|> nodeAPI  conn (Proxy :: Proxy HyperdataAnnuaire)
 287      :<|> nodesAPI conn
 288      :<|> count -- TODO: undefined
 289      :<|> search   conn
 290      :<|> graphAPI conn -- TODO: mock
 291      :<|> treeAPI  conn
 292   --   :<|> orchestrator
 293   where
 294     conn = env ^. env_conn
 295
 296 serverIndex :: Server (Get '[HTML] Html)
 297 serverIndex = $(do (Just s) <- liftIO (fileTypeToFileTree (FileTypeFile "purescript-gargantext/dist/index.html"))
 298                    fileTreeToServer s)
 299
 300 ---------------------------------------------------------------------
 301 swaggerFront :: Server SwaggerFrontAPI
 302 swaggerFront = schemaUiServer swaggerDoc
 303            :<|> frontEndServer
 304
 305 gargMock :: Server GargAPI
 306 gargMock = mock apiGarg Proxy
 307
 308 ---------------------------------------------------------------------
 309 makeApp :: Env -> IO Application
 310 makeApp = fmap (serve api) . server
 311
 312 appMock :: Application
 313 appMock = serve api (swaggerFront :<|> gargMock :<|> serverIndex)
 314
 315 ---------------------------------------------------------------------
 316 api :: Proxy API
 317 api  = Proxy
 318
 319 apiGarg :: Proxy GargAPI
 320 apiGarg  = Proxy
 321 ---------------------------------------------------------------------
 322
 323 schemaUiServer :: (Server api ~ Handler Swagger)
 324         => Swagger -> Server (SwaggerSchemaUI' dir api)
 325 schemaUiServer = swaggerSchemaUIServer
 326
 327
 328 -- Type Family for the Documentation
 329 type family TypeName (x :: *) :: Symbol where
 330     TypeName Int  = "Int"
 331     TypeName Text = "Text"
 332     TypeName x    = GenericTypeName x (Rep x ())
 333
 334 type family GenericTypeName t (r :: *) :: Symbol where
 335     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 336
 337 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 338
 339
 340 -- | Swagger Specifications
 341 swaggerDoc :: Swagger
 342 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 343   & info.title       .~ "Gargantext"
 344   & info.version     .~ "4.0.2" -- TODO same version as Gargantext
 345   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 346   & info.description ?~ "REST API specifications"
 347   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 348   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 349                  ["Gargantext" & description ?~ "Main operations"]
 350   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 351     where
 352         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 353
 354 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 355 swaggerWriteJSON :: IO ()
 356 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 357
 358 portRouteInfo :: PortNumber -> IO ()
 359 portRouteInfo port = do
 360   T.putStrLn "      ----Main Routes-----      "
 361   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 362   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 363
 364 -- | startGargantext takes as parameters port number and Ini file.
 365 startGargantext :: PortNumber -> FilePath -> IO ()
 366 startGargantext port file = do
 367   env <- newEnv port file
 368   portRouteInfo port
 369   app <- makeDevApp env
 370   run port app
 371
 372 startGargantextMock :: PortNumber -> IO ()
 373 startGargantextMock port = do
 374   portRouteInfo port
 375   application <- makeMockApp . MockEnv $ FireWall False
 376   run port application
 377