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