src/Gargantext/Server.hs

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