src/Gargantext/API.hs

   1 {-|
   2 Module      : Gargantext.API
   3 Description : Server API
   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 Provide config, state, logs and IO
  14  type App m a =  ( MonadState AppState m
  15                  , MonadReader Conf m
  16                  , MonadLog (WithSeverity Doc) m
  17                  , MonadIO m) => m a
  18 Thanks @yannEsposito for this.
  19 -}
  20
  21 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  22
  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 import           Gargantext.Prelude
  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           Data.Aeson.Encode.Pretty (encodePretty)
  48 import qualified Data.ByteString.Lazy.Char8 as BL8
  49 import           Data.Swagger
  50 import           Data.Text (Text)
  51 import qualified Data.Text.IO as T
  52 --import qualified Data.Set as Set
  53
  54 import           Network.Wai
  55 import           Network.Wai.Handler.Warp hiding (defaultSettings)
  56
  57 import           Servant
  58 import           Servant.Mock (mock)
  59 import           Servant.Job.Server (WithCallbacks)
  60 import           Servant.Swagger
  61 import           Servant.Swagger.UI
  62 -- import Servant.API.Stream
  63
  64 --import Gargantext.API.Swagger
  65 import Gargantext.API.FrontEnd (FrontEndAPI, frontEndServer)
  66
  67 import Gargantext.API.Node ( Roots    , roots
  68                            , NodeAPI  , nodeAPI
  69                            , NodesAPI , nodesAPI
  70                            )
  71 import Gargantext.API.Count ( CountAPI, count, Query)
  72 import Gargantext.API.Orchestrator
  73 import Gargantext.API.Orchestrator.Types
  74
  75 ---------------------------------------------------------------------
  76
  77 import GHC.Base (Applicative)
  78 -- import Control.Lens
  79
  80 import Data.List (lookup)
  81 import Data.Text.Encoding (encodeUtf8)
  82
  83 --import Network.Wai (Request, requestHeaders, responseLBS)
  84 import Network.Wai (Request, requestHeaders)
  85 --import qualified Network.Wai.Handler.Warp as Warp
  86 import Network.Wai.Middleware.Cors
  87
  88 import Network.Wai.Middleware.RequestLogger
  89 -- import qualified Network.Wai.Middleware.RequestLogger as RequestLogger
  90
  91 import Network.HTTP.Types hiding (Query)
  92
  93
  94 import Gargantext.API.Settings
  95
  96 fireWall :: Applicative f => Request -> FireWall -> f Bool
  97 fireWall req fw = do
  98     let origin = lookup "Origin" (requestHeaders req)
  99     let host   = lookup "Host"   (requestHeaders req)
 100
 101     let hostOk   = Just (encodeUtf8 "localhost:3000")
 102     let originOk = Just (encodeUtf8 "http://localhost:8008")
 103
 104     if  origin == originOk
 105        && host == hostOk
 106        || (not $ unFireWall fw)
 107
 108        then pure True
 109        else pure False
 110
 111
 112 -- makeMockApp :: Env -> IO (Warp.Settings, Application)
 113 makeMockApp :: MockEnv -> IO Application
 114 makeMockApp env = do
 115     let serverApp = appMock
 116
 117     -- logWare <- mkRequestLogger def { destination = RequestLogger.Logger $ env^.logger }
 118     --logWare <- mkRequestLogger def { destination = RequestLogger.Logger "/tmp/logs.txt" }
 119     let checkOriginAndHost app req resp = do
 120             blocking <- fireWall req (env ^. menv_firewall)
 121             case blocking  of
 122                 True  -> app req resp
 123                 False -> resp ( responseLBS status401 []
 124                               "Invalid Origin or Host header")
 125
 126     let corsMiddleware = cors $ \_ -> Just CorsResourcePolicy
 127 --          { corsOrigins        = Just ([env^.settings.allowedOrigin], False)
 128             { corsOrigins        = Nothing --  == /*
 129             , corsMethods        = [ methodGet   , methodPost   , methodPut
 130                                    , methodDelete, methodOptions, methodHead]
 131             , corsRequestHeaders = ["authorization", "content-type"]
 132             , corsExposedHeaders = Nothing
 133             , corsMaxAge         = Just ( 60*60*24 ) -- one day
 134             , corsVaryOrigin     = False
 135             , corsRequireOrigin  = False
 136             , corsIgnoreFailures = False
 137             }
 138
 139     --let warpS = Warp.setPort (8008 :: Int)   -- (env^.settings.appPort)
 140     --          $ Warp.defaultSettings
 141
 142     --pure (warpS, logWare $ checkOriginAndHost $ corsMiddleware $ serverApp)
 143     pure $ logStdoutDev $ checkOriginAndHost $ corsMiddleware $ serverApp
 144
 145
 146 ---------------------------------------------------------------------
 147 -- | API Global
 148
 149 -- | API for serving @swagger.json@
 150 type SwaggerAPI = SwaggerSchemaUI "swagger-ui" "swagger.json"
 151
 152 -- | API for serving main operational routes of @gargantext.org@
 153 type GargAPI =  "user"  :> Summary "First user endpoint"
 154                         :> Roots
 155
 156            :<|> "node"  :> Summary "Node endpoint"
 157                         :> Capture "id" Int      :> NodeAPI
 158
 159            :<|> "corpus":> Summary "Corpus endpoint"
 160                         :> Capture "id" Int      :> NodeAPI
 161
 162            :<|> "nodes" :> Summary "Nodes endpoint"
 163                         :> ReqBody '[JSON] [Int] :> NodesAPI
 164
 165        -- :<|> "counts" :> Stream GET NewLineFraming '[JSON] Count :> CountAPI
 166            :<|> "count" :> Summary "Count endpoint"
 167                         :> ReqBody '[JSON] Query :> CountAPI
 168
 169            :<|> "scraper" :> WithCallbacks ScraperAPI
 170
 171 -- /mv/<id>/<id>
 172 -- /merge/<id>/<id>
 173 -- /rename/<id>
 174        -- :<|> "static"
 175        -- :<|> "list"     :> Capture "id" Int  :> NodeAPI
 176        -- :<|> "ngrams"   :> Capture "id" Int  :> NodeAPI
 177        -- :<|> "auth"     :> Capture "id" Int  :> NodeAPI
 178 ---------------------------------------------------------------------
 179 type SwaggerFrontAPI = SwaggerAPI :<|> FrontEndAPI
 180
 181 type API = SwaggerFrontAPI :<|> GargAPI
 182
 183 ---------------------------------------------------------------------
 184 -- | Server declaration
 185 server :: Env -> IO (Server API)
 186 server env = do
 187   orchestrator <- scrapyOrchestrator env
 188   pure $ swaggerFront
 189      :<|> roots    conn
 190      :<|> nodeAPI  conn
 191      :<|> nodeAPI  conn
 192      :<|> nodesAPI conn
 193      :<|> count
 194      :<|> orchestrator
 195   where
 196     conn = env ^. env_conn
 197
 198 ---------------------------------------------------------------------
 199 swaggerFront :: Server SwaggerFrontAPI
 200 swaggerFront = schemaUiServer swaggerDoc
 201            :<|> frontEndServer
 202
 203 gargMock :: Server GargAPI
 204 gargMock = mock apiGarg Proxy
 205
 206 ---------------------------------------------------------------------
 207 makeApp :: Env -> IO Application
 208 makeApp = fmap (serve api) . server
 209
 210 appMock :: Application
 211 appMock = serve api (swaggerFront :<|> gargMock)
 212
 213 ---------------------------------------------------------------------
 214 api :: Proxy API
 215 api  = Proxy
 216
 217 apiGarg :: Proxy GargAPI
 218 apiGarg  = Proxy
 219 ---------------------------------------------------------------------
 220
 221 schemaUiServer :: (Server api ~ Handler Swagger)
 222         => Swagger -> Server (SwaggerSchemaUI' dir api)
 223 schemaUiServer = swaggerSchemaUIServer
 224
 225
 226 -- Type Family for the Documentation
 227 type family TypeName (x :: *) :: Symbol where
 228     TypeName Int  = "Int"
 229     TypeName Text = "Text"
 230     TypeName x    = GenericTypeName x (Rep x ())
 231
 232 type family GenericTypeName t (r :: *) :: Symbol where
 233     GenericTypeName t (D1 ('MetaData name mod pkg nt) f x) = name
 234
 235 type Desc t n = Description (AppendSymbol (TypeName t) (AppendSymbol " | " n))
 236
 237
 238 -- | Swagger Specifications
 239 swaggerDoc :: Swagger
 240 swaggerDoc = toSwagger (Proxy :: Proxy GargAPI)
 241   & info.title       .~ "Gargantext"
 242   & info.version     .~ "0.1.0"
 243   -- & info.base_url     ?~ (URL "http://gargantext.org/")
 244   & info.description ?~ "REST API specifications"
 245   -- & tags             .~ Set.fromList [Tag "Garg" (Just "Main perations") Nothing]
 246   & applyTagsFor (subOperations (Proxy :: Proxy GargAPI)(Proxy :: Proxy GargAPI))
 247                  ["Garg" & description ?~ "Main operations"]
 248   & info.license     ?~ ("AGPLV3 (English) and CECILL (French)" & url ?~ URL urlLicence )
 249     where
 250         urlLicence = "https://gitlab.iscpif.fr/gargantext/haskell-gargantext/blob/master/LICENSE"
 251
 252 -- | Output generated @swagger.json@ file for the @'TodoAPI'@.
 253 swaggerWriteJSON :: IO ()
 254 swaggerWriteJSON = BL8.writeFile "swagger.json" (encodePretty swaggerDoc)
 255
 256 portRouteInfo :: PortNumber -> IO ()
 257 portRouteInfo port = do
 258   T.putStrLn "      ----Main Routes-----      "
 259   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/index.html"
 260   T.putStrLn $ "http://localhost:" <> toUrlPiece port <> "/swagger-ui"
 261
 262 -- | startGargantext takes as parameters port number and Ini file.
 263 startGargantext :: PortNumber -> FilePath -> IO ()
 264 startGargantext port file = do
 265   env <- newEnv port file
 266   portRouteInfo port
 267   app <- makeApp env
 268   run port app
 269
 270 startGargantextMock :: PortNumber -> IO ()
 271 startGargantextMock port = do
 272   portRouteInfo port
 273
 274   application <- makeMockApp . MockEnv $ FireWall False
 275
 276   run port application
 277