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