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 Thanks @yannEsposito for our discussions at the beginning of this project :).
  12
  13 -}
  14
  15 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  16
  17 {-# LANGUAGE NoImplicitPrelude    #-}
  18 {-# LANGUAGE DataKinds            #-}
  19 {-# LANGUAGE DeriveGeneric        #-}
  20 {-# LANGUAGE FlexibleContexts     #-}
  21 {-# LANGUAGE FlexibleInstances    #-}
  22 {-# LANGUAGE OverloadedStrings    #-}
  23 {-# LANGUAGE TemplateHaskell      #-}
  24 {-# LANGUAGE TypeOperators        #-}
  25 {-# LANGUAGE KindSignatures       #-}
  26 {-# LANGUAGE RankNTypes           #-}
  27 {-# LANGUAGE ScopedTypeVariables  #-}
  28 {-# LANGUAGE TypeFamilies         #-}
  29 {-# LANGUAGE UndecidableInstances #-}
  30
  31 ---------------------------------------------------------------------
  32 module Gargantext.API
  33       where
  34 ---------------------------------------------------------------------
  35
  36 import           System.IO (FilePath)
  37
  38 import           GHC.Generics (D1, Meta (..), Rep)
  39 import           GHC.TypeLits (AppendSymbol, Symbol)
  40
  41 import           Control.Lens
  42 import           Control.Exception (finally)
  43 import           Control.Monad.Except (withExceptT, ExceptT)
  44 import           Control.Monad.IO.Class (liftIO)
  45 import           Control.Monad.Reader (ReaderT, runReaderT)
  46 import           Data.Aeson.Encode.Pretty (encodePretty)
  47 import qualified Data.ByteString.Lazy.Char8 as BL8
  48 import           Data.Swagger
  49 import           Data.Text (Text)
  50 import qualified Data.Text.IO as T
  51 --import qualified Data.Set as Set
  52 import           Data.Validity
  53
  54 import           Network.Wai
  55 import           Network.Wai.Handler.Warp hiding (defaultSettings)
  56
  57 import           Servant
  58 import           Servant.HTML.Blaze (HTML)
  59 --import           Servant.Mock (mock)
  60 --import           Servant.Job.Server (WithCallbacks)
  61 import           Servant.Static.TH.Internal.Server (fileTreeToServer)
  62 import           Servant.Static.TH.Internal.FileTree (fileTypeToFileTree, FileType(FileTypeFile))
  63 import           Servant.Swagger
  64 import           Servant.Swagger.UI
  65 -- import Servant.API.Stream
  66 import           Text.Blaze.Html (Html)
  67
  68 --import Gargantext.API.Swagger
  69
  70 --import Gargantext.Database.Node.Contact (HyperdataContact)
  71 import Gargantext.API.Auth (AuthRequest, AuthResponse, auth)
  72 import Gargantext.API.Count  ( CountAPI, count, Query)
  73 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
  74 import Gargantext.API.Ngrams (HasRepo(..), HasRepoSaver(..), saveRepo, TableNgramsApi, apiNgramsTableDoc)
  75 import Gargantext.API.Node
  76 import Gargantext.API.Search (SearchPairsAPI, searchPairs)
  77 import Gargantext.API.Types
  78 import qualified Gargantext.API.Corpus.New as New
  79 import Gargantext.Core.Types (HasInvalidError(..))
  80 import Gargantext.Database.Schema.Node (HasNodeError(..), NodeError)
  81 import Gargantext.Database.Tree (HasTreeError(..), TreeError)
  82 import Gargantext.Database.Types.Node
  83 import Gargantext.Database.Types.Node (NodeId, CorpusId, AnnuaireId)
  84 import Gargantext.Database.Utils (HasConnection)
  85 import Gargantext.Prelude
  86 import Gargantext.Viz.Graph.API
  87
  88 --import Gargantext.API.Orchestrator
  89 --import Gargantext.API.Orchestrator.Types
  90
  91 ---------------------------------------------------------------------
  92
  93 import GHC.Base (Applicative)
  94 -- import Control.Lens
  95
  96 import Data.List (lookup)
  97 import Data.Text.Encoding (encodeUtf8)
  98
  99 --import Network.Wai (Request, requestHeaders, responseLBS)
 100 import Network.Wai (Request, requestHeaders)
 101 --import qualified Network.Wai.Handler.Warp as Warp
 102 import Network.Wai.Middleware.Cors
 103
 104 import Network.Wai.Middleware.RequestLogger
 105 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
 106
 107 import Network.HTTP.Types hiding (Query)
 108
 109
 110 import Gargantext.API.Settings
 111
 112 data GargError
 113   = GargNodeError NodeError
 114   | GargTreeError TreeError
 115   | GargInvalidError Validation
 116   deriving (Show)
 117
 118 makePrisms ''GargError
 119
 120 instance HasNodeError GargError where
 121   _NodeError = _GargNodeError
 122
 123 instance HasInvalidError GargError where
 124   _InvalidError = _GargInvalidError
 125
 126 instance HasTreeError GargError where
 127   _TreeError = _GargTreeError
 128
 129 showAsServantErr :: Show a => a -> ServantErr
 130 showAsServantErr a = err500 { errBody = BL8.pack $ show a }
 131
 132 fireWall :: Applicative f => Request -> FireWall -> f Bool
 133 fireWall req fw = do
 134     let origin = lookup "Origin" (requestHeaders req)
 135     let host   = lookup "Host"   (requestHeaders req)
 136
 137     let hostOk   = Just (encodeUtf8 "localhost:3000")
 138     let originOk = Just (encodeUtf8 "http://localhost:8008")
 139
 140     if  origin == originOk
 141        && host == hostOk
 142        || (not $ unFireWall fw)
 143
 144        then pure True
 145        else pure False
 146
 147 {-
 148 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
 149 makeMockApp :: MockEnv -> IO Application
 150 makeMockApp env = do
 151     let serverApp = appMock
 152
 153     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 154     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 155     let checkOriginAndHost app req resp = do
 156             blocking <- fireWall req (env ^. menv_firewall)
 157             case blocking  of
 158                 True  -> app req resp
 159                 False -> resp ( responseLBS status401 []
 160                               "Invalid Origin or Host header")
 161
 162     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 163 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 164             { corsOrigins        = Nothing --  == /*
 165             , corsMethods        = [ methodGet   , methodPost   , methodPut
 166                                    , methodDelete, methodOptions, methodHead]
 167             , corsRequestHeaders = ["authorization", "content-type"]
 168             , corsExposedHeaders = Nothing
 169             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 170             , corsVaryOrigin     = False
 171             , corsRequireOrigin  = False
 172             , corsIgnoreFailures = False
 173             }
 174
 175     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 176     --          $ Warp.defaultSettings
 177
 178     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 179     pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
 180 -}
 181
 182
 183 makeDevMiddleware :: IO Middleware
 184 makeDevMiddleware = do
 185
 186     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 187     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 188 --    let checkOriginAndHost app req resp = do
 189 --            blocking <- fireWall req (env ^. menv_firewall)
 190 --            case blocking  of
 191 --                True  -> app req resp
 192 --                False -> resp ( responseLBS status401 []
 193 --                              "Invalid Origin or Host header")
 194 --
 195     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 196 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 197             { corsOrigins        = Nothing --  == /*
 198             , corsMethods        = [ methodGet   , methodPost   , methodPut
 199                                    , methodDelete, methodOptions, methodHead]
 200             , corsRequestHeaders = ["authorization", "content-type"]
 201             , corsExposedHeaders = Nothing
 202             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 203             , corsVaryOrigin     = False
 204             , corsRequireOrigin  = False
 205             , corsIgnoreFailures = False
 206             }
 207
 208     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 209     --          $ Warp.defaultSettings
 210
 211     --pure (warpS, logWare . checkOriginAndHost . corsMiddleware)
 212     pure $ logStdoutDev . corsMiddleware
 213
 214 ---------------------------------------------------------------------
 215 -- | API Global
 216
 217 -- | API for serving @swagger.json@
 218 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
 219
 220 -- | API for serving main operational routes of @gargantext.org@
 221
 222
 223 type GargAPI = "api" :> Summary "API " :> GargAPIVersion
 224 -- | TODO          :<|> Summary "Latest API" :> GargAPI'
 225
 226
 227 type GargAPIVersion = "v1.0" :> Summary "v1.0: " :> GargAPI'
 228
 229 type GargAPI' =
 230            -- Auth endpoint
 231                 "auth"  :> Summary "AUTH API"
 232                         :> ReqBody '[JSON] AuthRequest
 233                         :> Post    '[JSON] AuthResponse
 234
 235            -- Roots endpoint
 236           :<|>  "user"  :> Summary "First user endpoint"
 237                         :> Roots
 238
 239            -- Node endpoint
 240            :<|> "node"  :> Summary "Node endpoint"
 241                         :> Capture "id" NodeId      :> NodeAPI HyperdataAny
 242
 243            -- Corpus endpoint
 244            :<|> "corpus":> Summary "Corpus endpoint"
 245                         :> Capture "id" CorpusId      :> NodeAPI HyperdataCorpus
 246
 247            -- Annuaire endpoint
 248            :<|> "annuaire":> Summary "Annuaire endpoint"
 249                           :> Capture "id" AnnuaireId      :> NodeAPI HyperdataAnnuaire
 250
 251            -- Document endpoint
 252            :<|> "document":> Summary "Document endpoint"
 253                           :> Capture "id" DocId    :> "ngrams" :> TableNgramsApi
 254
 255            -- Corpus endpoint
 256            :<|> "nodes" :> Summary "Nodes endpoint"
 257                         :> ReqBody '[JSON] [NodeId] :> NodesAPI
 258
 259         -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
 260            -- Corpus endpoint
 261            :<|> "count" :> Summary "Count endpoint"
 262                         :> ReqBody '[JSON] Query :> CountAPI
 263
 264            -- Corpus endpoint --> TODO rename s/search/filter/g
 265            :<|> "search":> Capture "corpus" NodeId :> SearchPairsAPI
 266
 267            -- TODO move to NodeAPI?
 268            :<|> "graph" :> Summary "Graph endpoint"
 269                         :> Capture "id" NodeId       :> GraphAPI
 270
 271            -- TODO move to NodeAPI?
 272            -- Tree endpoint
 273            :<|> "tree" :> Summary "Tree endpoint"
 274                        :> Capture "id" NodeId        :> TreeAPI
 275
 276            :<|> "new"  :> New.Api
 277
 278
 279        --    :<|> "scraper" :> WithCallbacks ScraperAPI
 280
 281 -- /mv/<id>/<id>
 282 -- /merge/<id>/<id>
 283 -- /rename/<id>
 284        -- :<|> "static"
 285        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
 286        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
 287        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 288 ---------------------------------------------------------------------
 289 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 290
 291 type API = SwaggerFrontAPI :<|> GargAPI :<|> Get '[HTML] Html
 292
 293 ---------------------------------------------------------------------
 294 -- | Server declarations
 295
 296 server :: forall env. (HasConnection env, HasRepo env, HasSettings env)
 297        => env -> IO (Server API)
 298 server env = do
 299   -- orchestrator <- scrapyOrchestrator env
 300   pure $  swaggerFront
 301      :<|> hoistServer (Proxy :: Proxy GargAPI) transform serverGargAPI
 302      :<|> serverStatic
 303   where
 304     transform :: forall a. ReaderT env (ExceptT GargError IO) a -> Handler a
 305     transform = Handler . withExceptT showAsServantErr . (`runReaderT` env)
 306
 307 serverGargAPI :: GargServer GargAPI
 308 serverGargAPI -- orchestrator
 309        =  auth
 310      :<|> roots
 311      :<|> nodeAPI  (Proxy :: Proxy HyperdataAny)      fakeUserId
 312      :<|> nodeAPI  (Proxy :: Proxy HyperdataCorpus)   fakeUserId
 313      :<|> nodeAPI  (Proxy :: Proxy HyperdataAnnuaire) fakeUserId
 314      :<|> apiNgramsTableDoc
 315      :<|> nodesAPI
 316      :<|> count -- TODO: undefined
 317      :<|> searchPairs -- TODO: move elsewhere
 318      :<|> graphAPI -- TODO: mock
 319      :<|> treeAPI
 320      :<|> New.api
 321   --   :<|> orchestrator
 322   where
 323     fakeUserId = 1 -- TODO
 324
 325 serverStatic :: Server (Get '[HTML] Html)
 326 serverStatic = $(do
 327                 let path = "purescript-gargantext/dist/index.html"
 328                 Just s <- liftIO (fileTypeToFileTree (FileTypeFile path))
 329                 fileTreeToServer s
 330                 )
 331
 332 ---------------------------------------------------------------------
 333 swaggerFront :: Server SwaggerFrontAPI
 334 swaggerFront = schemaUiServer swaggerDoc
 335            :<|> frontEndServer
 336
 337 --gargMock :: Server GargAPI
 338 --gargMock = mock apiGarg Proxy
 339
 340 ---------------------------------------------------------------------
 341 makeApp :: (HasConnection env, HasRepo env, HasSettings env)
 342         => env -> IO Application
 343 makeApp = fmap (serve api) . server
 344
 345 --appMock :: Application
 346 --appMock = serve api (swaggerFront :<|> gargMock :<|> serverStatic)
 347
 348 ---------------------------------------------------------------------
 349 api :: Proxy API
 350 api  = Proxy
 351
 352 apiGarg :: Proxy GargAPI
 353 apiGarg  = Proxy
 354 ---------------------------------------------------------------------
 355
 356 schemaUiServer :: (Server api ~ Handler Swagger)
 357         => Swagger -> Server (SwaggerSchemaUI' dir api)
 358 schemaUiServer = swaggerSchemaUIServer
 359
 360
 361 -- Type Family for the Documentation
 362 type family TypeName (x :: *) :: Symbol where
 363     TypeName Int  = "Int"
 364     TypeName Text = "Text"
 365     TypeName x    = GenericTypeName x (Rep x ())
 366
 367 type family GenericTypeName t (r :: *) :: Symbol where
 368     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 369
 370 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 371
 372
 373 -- | Swagger Specifications
 374 swaggerDoc :: Swagger
 375 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 376   & info.title       .~ "Gargantext"
 377   & info.version     .~ "4.0.2" -- TODO same version as Gargantext
 378   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 379   & info.description ?~ "REST API specifications"
 380   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 381   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 382                  ["Gargantext" & description ?~ "Main operations"]
 383   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 384     where
 385         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 386
 387 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 388 swaggerWriteJSON :: IO ()
 389 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 390
 391 portRouteInfo :: PortNumber -> IO ()
 392 portRouteInfo port = do
 393   T.putStrLn "      ----Main Routes-----      "
 394   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 395   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 396
 397 stopGargantext :: HasRepoSaver env => env -> IO ()
 398 stopGargantext env = do
 399   T.putStrLn "----- Stopping gargantext -----"
 400   runReaderT saveRepo env
 401
 402 -- | startGargantext takes as parameters port number and Ini file.
 403 startGargantext :: PortNumber -> FilePath -> IO ()
 404 startGargantext port file = do
 405   env <- newEnv port file
 406   portRouteInfo port
 407   app <- makeApp env
 408   mid <- makeDevMiddleware
 409   run port (mid app) `finally` stopGargantext env
 410
 411 {-
 412 startGargantextMock :: PortNumber -> IO ()
 413 startGargantextMock port = do
 414   portRouteInfo port
 415   application <- makeMockApp . MockEnv $ FireWall False
 416   run port application
 417 -}
 418
 419
 420
 421