src/Gargantext/Server.hs

   1
   2 {-|
   3 Module      : Gargantext.Server
   4 Description : Server API
   5 Copyright   : (c) CNRS, 2017-Present
   6 License     : AGPL + CECILL v3
   7 Maintainer  : team@gargantext.org
   8 Stability   : experimental
   9 Portability : POSIX
  10
  11 Main REST API of Gargantext (both Server and Client sides)
  12
  13 -}
  14
  15 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
  16 {-# LANGUAGE DataKinds       #-}
  17 {-# LANGUAGE TemplateHaskell #-}
  18 {-# LANGUAGE TypeOperators   #-}
  19 module Gargantext.Server
  20 --    ( startApp
  21 --    , app
  22 --    )
  23       where
  24
  25 import Gargantext.Prelude
  26
  27 import Control.Monad
  28 import Control.Monad.IO.Class
  29 import Data.Aeson
  30 import Network.Wai
  31 import Network.Wai.Handler.Warp
  32 import Servant
  33 import Servant.Multipart
  34 import Database.PostgreSQL.Simple (Connection, connect)
  35 import Opaleye
  36 import System.IO (FilePath, putStrLn, readFile, print)
  37 import Data.Text (Text(), pack)
  38 import Gargantext.Types.Main (Node, NodeId)
  39 import Gargantext.Database.Node (getNodesWithParentId, getNode)
  40 import Gargantext.Database.Private (databaseParameters)
  41
  42 -- | TODO, use MOCK feature of Servant to generate fake data (for tests)
  43
  44 type NodeAPI = Get '[JSON] (Node Value)
  45            :<|> "children" :> Get '[JSON] [Node Value]
  46
  47 type API =  "roots"  :> Get '[JSON] [Node Value]
  48        :<|> "node"   :> Capture "id" Int            :> NodeAPI
  49        :<|> "echo"   :> Capture "string" Text     :> Get '[JSON] Text
  50        :<|> "upload" :> MultipartForm MultipartData :> Post '[JSON] Text
  51
  52        -- :<|> "node"  :> Capture "id" Int        :> Get '[JSON] Node
  53
  54 server :: Connection -> Server API
  55 server conn
  56     = liftIO (getNodesWithParentId conn 0)
  57   :<|> nodeAPI conn
  58   :<|> echo
  59   :<|> upload
  60     where
  61         echo s = pure s
  62
  63 startGargantext :: Int -> FilePath -> IO ()
  64 startGargantext port file = do
  65
  66   print ("Starting server on port " <> show port)
  67   param <- databaseParameters file
  68   conn  <- connect param
  69
  70   run port $ app conn
  71
  72 -- | TODO App type, the main monad in which the bot code is written with.
  73 -- Provide config, state, logs and IO
  74 -- type App m a =  ( MonadState AppState m
  75 --                 , MonadReader Conf m
  76 --                 , MonadLog (WithSeverity Doc) m
  77 --                 , MonadIO m) => m a
  78 -- Thanks @yannEsposito for this.
  79 app :: Connection -> Application
  80 app = serve api . server
  81
  82 api :: Proxy API
  83 api = Proxy
  84
  85 nodeAPI :: Connection -> NodeId -> Server NodeAPI
  86 nodeAPI conn id
  87     =  liftIO (getNode conn id')
  88   :<|> liftIO (getNodesWithParentId conn id)
  89     where
  90         id' = pgInt4 id
  91
  92 -- | Upload files
  93 -- TODO Is it possible to adapt the function according to iValue input ?
  94 upload :: MultipartData -> Handler Text
  95 upload multipartData = do
  96   liftIO $ do
  97     putStrLn "Inputs:"
  98     forM_ (inputs multipartData) $ \input ->
  99       putStrLn $ "  " <> show (iName input)
 100             <> " -> " <> show (iValue input)
 101
 102     forM_ (files multipartData) $ \file -> do
 103       content <- readFile (fdFilePath file)
 104       putStrLn $ "Content of " <> show (fdFileName file)
 105               <> " at " <> fdFilePath file
 106       putStrLn content
 107   pure (pack "Data loaded")