1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
{-# LANGUAGE TypeOperators #-}
module Gargantext.Core.Text.Upload
( Host(..)
, DocId(..)
, Data(..)
, ContentType (..)
, ethercalc
, codimd
)
where
import qualified Data.Map.Strict as Map
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import Gargantext.Utils.Servant (CSV, Markdown)
import Network.HTTP.Client (newManager, Request(..))
import Network.HTTP.Client.TLS (tlsManagerSettings)
import Protolude
import Servant.API
import Servant.Client
newtype Host = Host { fromHost :: Text }
newtype DocId = DocId { fromDocId :: Text }
newtype Data = Data { fromData :: Text }
data ContentType a =
CTPlain a
| CTCSV a
-- TODO SocialCalc, Excel XML ?
instance MimeRender CSV Data where
mimeRender p (Data d) = mimeRender p d
instance MimeRender PlainText Data where
mimeRender p (Data d) = mimeRender p d
instance ToHttpApiData DocId where
toUrlPiece (DocId docId) = docId
-- https://github.com/audreyt/ethercalc/blob/master/API.md
type EthercalcAPI =
"_" :> (
-- plain text
ReqBody '[PlainText] Data
:> Post '[PlainText] Text
:<|>
Capture "docId" DocId
:> ReqBody '[PlainText] Data
:> Put '[PlainText] Text
-- csv
:<|>
ReqBody '[CSV] Data
:> Post '[PlainText, CSV] Text
:<|>
Capture "docId" DocId
:> ReqBody '[CSV] Data
:> Put '[PlainText, CSV] Text
)
ethercalcAPI :: Proxy EthercalcAPI
ethercalcAPI = Proxy
ethercalcNewPlain :: Data -> ClientM Text
ethercalcUpdatePlain :: DocId -> Data -> ClientM Text
ethercalcNewCSV :: Data -> ClientM Text
ethercalcUpdateCSV :: DocId -> Data -> ClientM Text
ethercalcNewPlain :<|> ethercalcUpdatePlain
:<|> ethercalcNewCSV :<|> ethercalcUpdateCSV = client ethercalcAPI
------------------------------
-- | Create new or update existing Ethercalc document (depending on
-- `Maybe DocId` constructor). `Data` can be in various formats (CSV,
-- etc).
ethercalc :: Host -> Maybe DocId -> ContentType Data -> IO (Either ClientError Text)
ethercalc (Host host) mDocId ctD = do
manager' <- newManager tlsManagerSettings
let env = mkClientEnv manager' (BaseUrl Https (T.unpack host) 443 "")
case (mDocId, ctD) of
(Nothing, CTPlain d) -> runClientM (ethercalcNewPlain d) env
(Nothing, CTCSV d) -> runClientM (ethercalcNewCSV d) env
(Just docId, CTPlain d) -> runClientM (ethercalcUpdatePlain docId d) env
(Just docId, CTCSV d) -> runClientM (ethercalcUpdateCSV docId d) env
-----------------------------------
type CodiMDAPI =
"new" :> (
ReqBody '[Markdown] Data
:> Post '[Markdown] Text
)
instance MimeRender Markdown Data where
mimeRender p (Data d) = mimeRender p d
codimdAPI :: Proxy CodiMDAPI
codimdAPI = Proxy
codimdAPINew :: Data -> ClientM Text
codimdAPINew = client codimdAPI
-- | Create a new CodiMD document (with Markdown contents). Please
-- note that AFAIK CodiMD update is not supported, see
-- https://github.com/hackmdio/codimd/issues/1013
codimd :: Host -> Data -> IO (Either Text Text)
codimd (Host host) d = do
manager' <- newManager tlsManagerSettings
let env' = mkClientEnv manager' (BaseUrl Https (T.unpack host) 443 "")
let env = env' { makeClientRequest = \burl req -> (defaultMakeClientRequest burl req) { redirectCount = 0 } }
eRes <- runClientM (codimdAPINew d) env
pure $ case eRes of
-- NOTE We actually expect a redirect here (a 302 with the new
-- page's URL). Hence we expect a `Left FailureResponse` because
-- we have set `redirectCount = 0` above.
Left (FailureResponse _req (Response { responseHeaders })) ->
case Map.lookup "location" (Map.fromList $ toList responseHeaders) of
Nothing -> Left "Cannot find 'Location' header in response"
Just loc -> Right $ TE.decodeUtf8 loc
err -> Left $ "Error creating codimd document: " <> show err