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