src/Gargantext/API/Node/Corpus/New/File.hs

   1 {-|
   2 Module      : Gargantext.API.Node.Corpus.New.File
   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 -}
  11
  12 {-# OPTIONS_GHC -fno-warn-orphans #-}
  13
  14 {-# LANGUAGE ScopedTypeVariables  #-}
  15 {-# LANGUAGE TemplateHaskell      #-}
  16 {-# LANGUAGE TypeOperators        #-}
  17
  18 module Gargantext.API.Node.Corpus.New.File
  19   where
  20
  21 import Control.Lens ((.~), (?~))
  22 import Control.Monad (forM)
  23 import Data.Aeson
  24 import Data.Maybe
  25 import Data.Monoid (mempty)
  26 import Data.Swagger
  27 import Data.Text (Text())
  28 import GHC.Generics (Generic)
  29
  30 import Servant
  31 import Servant.Multipart
  32 import Servant.Swagger.Internal
  33 import Test.QuickCheck (elements)
  34 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
  35
  36 import Gargantext.Core.Types (TODO)
  37 import Gargantext.Database.Admin.Types.Node
  38 import Gargantext.Database.Prelude -- (Cmd, CmdM)
  39 import Gargantext.Prelude
  40 import Gargantext.Prelude.Crypto.Hash (hash)
  41
  42 -------------------------------------------------------------
  43 type Hash = Text
  44 data FileType = CSV
  45               | CSV_HAL
  46               | PresseRIS
  47               | WOS
  48               | ZIP
  49   deriving (Eq, Show, Generic)
  50
  51 instance ToSchema FileType
  52 instance Arbitrary FileType where arbitrary = elements [CSV, PresseRIS]
  53 instance ToParamSchema FileType
  54
  55 instance FromJSON FileType
  56 instance ToJSON FileType
  57
  58 instance ToParamSchema (MultipartData Mem) where toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
  59
  60 instance FromHttpApiData FileType
  61   where
  62     parseUrlPiece "CSV"       = pure CSV
  63     parseUrlPiece "CSV_HAL"   = pure CSV_HAL
  64     parseUrlPiece "PresseRis" = pure PresseRIS
  65     parseUrlPiece "ZIP"       = pure ZIP
  66     parseUrlPiece "WOS"       = pure WOS
  67     parseUrlPiece _           = pure CSV -- TODO error here
  68
  69
  70 instance (ToParamSchema a, HasSwagger sub) =>
  71          HasSwagger (MultipartForm tag a :> sub) where
  72   -- TODO
  73   toSwagger _ = toSwagger (Proxy :: Proxy sub)
  74               & addParam param
  75     where
  76       param = mempty
  77             & required ?~ True
  78             & schema   .~ ParamOther sch
  79       sch = mempty
  80           & in_         .~ ParamFormData
  81           & paramSchema .~ toParamSchema (Proxy :: Proxy a)
  82
  83
  84 type WithUpload' = Summary "Upload file(s) to a corpus"
  85                 :> QueryParam "fileType"  FileType
  86                 :> MultipartForm Mem (MultipartData Mem)
  87                 :> Post '[JSON] [Hash]
  88
  89 --postUpload :: NodeId -> Maybe FileType ->  GargServer UploadAPI
  90 --postUpload :: NodeId -> GargServer UploadAPI
  91 postUpload :: NodeId
  92            -> Maybe FileType
  93            -> MultipartData Mem
  94            -> Cmd err [Hash]
  95 postUpload _ Nothing _ = panic "fileType is a required parameter"
  96 postUpload _ (Just fileType) multipartData = do
  97   printDebug "File Type: " fileType
  98   is <- liftBase $ do
  99     printDebug "Inputs:" ()
 100     forM (inputs multipartData) $ \input -> do
 101       printDebug "iName  " (iName input)
 102       printDebug "iValue " (iValue input)
 103       pure $ iName input
 104
 105   _ <- forM (files multipartData) $ \file -> do
 106     let content = fdPayload file
 107     printDebug "XXX " (fdFileName file)
 108     printDebug "YYY " content
 109     --pure $ cs content
 110   -- is <- inputs multipartData
 111
 112   pure $ map hash is
 113
 114 -------------------------------------------------------------------