]> Git — Sourcephile - gargantext.git/blob - src/Gargantext/API/Node/Corpus/New/File.hs
Merge branch 'dev-cbor' into dev
[gargantext.git] / 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 import Gargantext.API.Ngrams (TODO)
30 import Gargantext.Database.Admin.Types.Node
31 import Gargantext.Database.Prelude -- (Cmd, CmdM)
32 import Gargantext.Prelude
33 import Gargantext.Prelude.Crypto.Hash (hash)
34 import Servant
35 import Servant.Multipart
36 import Servant.Swagger (HasSwagger(toSwagger))
37 import Servant.Swagger.Internal
38 import Test.QuickCheck (elements)
39 import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary)
40
41 -------------------------------------------------------------
42 type Hash = Text
43 data FileType = CSV
44 | CSV_HAL
45 | PresseRIS
46 | WOS
47 deriving (Eq, Show, Generic)
48
49 instance ToSchema FileType
50 instance Arbitrary FileType
51 where
52 arbitrary = elements [CSV, PresseRIS]
53 instance ToParamSchema FileType
54
55 instance FromJSON FileType
56
57 instance ToParamSchema (MultipartData Mem) where
58 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 _ = pure CSV -- TODO error here
66
67
68 instance (ToParamSchema a, HasSwagger sub) =>
69 HasSwagger (MultipartForm tag a :> sub) where
70 -- TODO
71 toSwagger _ = toSwagger (Proxy :: Proxy sub)
72 & addParam param
73 where
74 param = mempty
75 & required ?~ True
76 & schema .~ ParamOther sch
77 sch = mempty
78 & in_ .~ ParamFormData
79 & paramSchema .~ toParamSchema (Proxy :: Proxy a)
80
81
82 type WithUpload' = Summary "Upload file(s) to a corpus"
83 :> QueryParam "fileType" FileType
84 :> MultipartForm Mem (MultipartData Mem)
85 :> Post '[JSON] [Hash]
86
87 --postUpload :: NodeId -> Maybe FileType -> GargServer UploadAPI
88 --postUpload :: NodeId -> GargServer UploadAPI
89 postUpload :: NodeId
90 -> Maybe FileType
91 -> MultipartData Mem
92 -> Cmd err [Hash]
93 postUpload _ Nothing _ = panic "fileType is a required parameter"
94 postUpload _ (Just fileType) multipartData = do
95 printDebug "File Type: " fileType
96 is <- liftBase $ do
97 printDebug "Inputs:" ()
98 forM (inputs multipartData) $ \input -> do
99 printDebug "iName " (iName input)
100 printDebug "iValue " (iValue input)
101 pure $ iName input
102
103 _ <- forM (files multipartData) $ \file -> do
104 let content = fdPayload file
105 printDebug "XXX " (fdFileName file)
106 printDebug "YYY " content
107 --pure $ cs content
108 -- is <- inputs multipartData
109
110 pure $ map hash is
111
112 -------------------------------------------------------------------