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