src/Data/Gargantext/Server.hs

   1 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
   2 {-# LANGUAGE DataKinds       #-}
   3 {-# LANGUAGE TemplateHaskell #-}
   4 {-# LANGUAGE TypeOperators   #-}
   5 module Data.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 Data.Gargantext.Types.Main (Node, NodeId)
  23 import Data.Gargantext.Database.Node (getNodesWithParentId, getNode)
  24 import Data.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 null)
  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 (toNullable id'))
  75        where id' = pgInt4 id
  76
  77 -- | Upload files
  78 -- TODO Is it possible to adapt the function according to iValue input ?
  79 upload :: MultipartData -> Handler String
  80 upload multipartData = do
  81   liftIO $ do
  82     putStrLn "Inputs:"
  83     forM_ (inputs multipartData) $ \input ->
  84       putStrLn $ "  " ++ show (iName input)
  85             ++ " -> " ++ show (iValue input)
  86
  87     forM_ (files multipartData) $ \file -> do
  88       content <- readFile (fdFilePath file)
  89       putStrLn $ "Content of " ++ show (fdFileName file)
  90               ++ " at " ++ fdFilePath file
  91       putStrLn content
  92   pure "Data loaded"