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