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