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   deriving (Eq, Show, Generic)
  49
  50 instance ToSchema FileType
  51 instance Arbitrary FileType
  52   where
  53     arbitrary = elements [CSV, PresseRIS]
  54 instance ToParamSchema FileType
  55
  56 instance FromJSON FileType
  57
  58 instance ToParamSchema (MultipartData Mem) where
  59   toParamSchema _ = toParamSchema (Proxy :: Proxy TODO)
  60
  61 instance FromHttpApiData FileType
  62   where
  63     parseUrlPiece "CSV"       = pure CSV
  64     parseUrlPiece "CSV_HAL"   = pure CSV_HAL
  65     parseUrlPiece "PresseRis" = pure PresseRIS
  66     parseUrlPiece _           = pure CSV -- TODO error here
  67
  68
  69 instance (ToParamSchema a, HasSwagger sub) =>
  70          HasSwagger (MultipartForm tag a :> sub) where
  71   -- TODO
  72   toSwagger _ = toSwagger (Proxy :: Proxy sub)
  73               & addParam param
  74     where
  75       param = mempty
  76             & required ?~ True
  77             & schema   .~ ParamOther sch
  78       sch = mempty
  79           & in_         .~ ParamFormData
  80           & paramSchema .~ toParamSchema (Proxy :: Proxy a)
  81
  82
  83 type WithUpload' = Summary "Upload file(s) to a corpus"
  84                 :> QueryParam "fileType"  FileType
  85                 :> MultipartForm Mem (MultipartData Mem)
  86                 :> Post '[JSON] [Hash]
  87
  88 --postUpload :: NodeId -> Maybe FileType ->  GargServer UploadAPI
  89 --postUpload :: NodeId -> GargServer UploadAPI
  90 postUpload :: NodeId
  91            -> Maybe FileType
  92            -> MultipartData Mem
  93            -> Cmd err [Hash]
  94 postUpload _ Nothing _ = panic "fileType is a required parameter"
  95 postUpload _ (Just fileType) multipartData = do
  96   printDebug "File Type: " fileType
  97   is <- liftBase $ do
  98     printDebug "Inputs:" ()
  99     forM (inputs multipartData) $ \input -> do
 100       printDebug "iName  " (iName input)
 101       printDebug "iValue " (iValue input)
 102       pure $ iName input
 103
 104   _ <- forM (files multipartData) $ \file -> do
 105     let content = fdPayload file
 106     printDebug "XXX " (fdFileName file)
 107     printDebug "YYY " content
 108     --pure $ cs content
 109   -- is <- inputs multipartData
 110
 111   pure $ map hash is
 112
 113 -------------------------------------------------------------------