REST.purs 6.41 KB
Newer Older
1
module Gargantext.Config.REST where
2

3
import Affjax (Error(..), defaultRequest, request)
4
import Affjax as Affjax
5
import Affjax.RequestBody (formData, formURLEncoded, string)
6
import Affjax.RequestHeader as ARH
Sudhir Kumar's avatar
Sudhir Kumar committed
7
import Affjax.ResponseFormat as ResponseFormat
8
import Data.Argonaut.Core as AC
9
import Data.Either (Either(..))
10 11
import Data.Foldable (foldMap)
import Data.FormURLEncoded as FormURLEncoded
12
import Data.Generic.Rep (class Generic)
Sudhir Kumar's avatar
Sudhir Kumar committed
13
import Data.HTTP.Method (Method(..))
14
import Data.Maybe (Maybe(..))
15
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
16
import Data.Tuple (Tuple)
17
import Effect (Effect)
18
import Effect.Aff (Aff)
19
import Effect.Class (liftEffect)
20
import Foreign as Foreign
21 22
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2
23
import Simple.JSON as JSON
24
import Web.XHR.FormData as XHRFormData
25

26 27
type Token = String

28 29 30
data RESTError =
    SendResponseError Affjax.Error
  | ReadJSONError     Foreign.MultipleErrors
31
  | CustomError       String
32
derive instance Generic RESTError _
33 34 35
instance Show RESTError where
  show (SendResponseError e) = "SendResponseError " <> showError e
    where
36
      showError (RequestContentError e')  = "(RequestContentError " <> show e' <> ")"
37
      showError (ResponseBodyError fe rf) = "(ResponseBodyError " <> show fe <> " (rf)"  -- <> show rf <> ")"
38 39 40 41 42
      showError (TimeoutError)            = "(TimeoutError)"
      showError (RequestFailedError)      = "(RequestFailedError)"
      showError (XHROtherError e')        = "(XHROtherError " <> show e' <> ")"
  show (ReadJSONError     e)              = "ReadJSONError " <> show e
  show (CustomError       s)              = "CustomError " <> s
43 44 45 46
instance Eq RESTError where
  -- this is crude but we need it only because of useLoader
  eq _ _ = false

47 48 49 50 51
logRESTError :: R2.Here -> String -> RESTError -> Effect Unit
logRESTError here prefix (SendResponseError e) = here.log2 (prefix <> " SendResponseError ") e  -- TODO: No show
logRESTError here prefix (ReadJSONError e) = here.log2 (prefix <> " ReadJSONError ") $ show e
logRESTError here prefix (CustomError e) = here.log2 (prefix <> " CustomError ") $ e

52 53
type AffRESTError a = Aff (Either RESTError a)

54

55 56 57 58 59 60
readJSON :: forall a b. JSON.ReadForeign a =>
            Either Affjax.Error
            { body :: AC.Json
            | b
            } -> Either RESTError a
readJSON affResp =
61 62
  case affResp of
    Left err -> do
63 64 65
      -- _ <- liftEffect $ log $ printError err
      --throwError $ error $ printError err
      Left $ SendResponseError err
66 67 68 69
    Right resp -> do
      --_ <-  liftEffect $ log json.status
      --_ <-  liftEffect $ log json.headers
      --_ <-  liftEffect $ log json.body
70 71 72
      case (JSON.readJSON $ AC.stringify resp.body) of
        Left err -> Left $ ReadJSONError err
        Right r -> Right r
73

74
-- TODO too much duplicate code in `postWwwUrlencoded`
75
send :: forall body res. JSON.WriteForeign body => JSON.ReadForeign res =>
76
        Method -> Maybe Token -> String -> Maybe body -> AffRESTError res
77
send m mtoken url reqbody = do
78
  let req = defaultRequest
79 80 81
         { url = url
         , responseFormat = ResponseFormat.json
         , method = Left m
82 83
         , headers =  [ ARH.ContentType applicationJSON
                      , ARH.Accept applicationJSON
84 85
                      ] <>
                      foldMap (\token ->
86
                        [ARH.RequestHeader "Authorization" $  "Bearer " <> token]
87
                      ) mtoken
88
         , content  = Just $ string $ JSON.writeJSON reqbody
89
         }
90 91 92 93 94
  case mtoken of
    Nothing -> pure unit
    Just token -> liftEffect $ do
      let cookie = "JWT-Cookie=" <> token <> "; Path=/;" --" HttpOnly; Secure; SameSite=Lax"
      R2.setCookie cookie
95
  affResp <- request req
96
  pure $ readJSON affResp
97

98 99 100
noReqBody :: Maybe String
noReqBody = Just ""
--noReqBody = Nothing
101

102
get :: forall a. JSON.ReadForeign a => Maybe Token -> String -> AffRESTError a
103
get mtoken url = send GET mtoken url noReqBody
104

105
put :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> AffRESTError b
106
put mtoken url = send PUT mtoken url <<< Just
107

108
put_ :: forall a. JSON.ReadForeign a => Maybe Token -> String -> AffRESTError a
109 110
put_ mtoken url = send PUT mtoken url noReqBody

111
delete :: forall a. JSON.ReadForeign a => Maybe Token -> String -> AffRESTError a
112
delete mtoken url = send DELETE mtoken url noReqBody
113

114 115
-- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
116
deleteWithBody :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> AffRESTError b
117
deleteWithBody mtoken url = send DELETE mtoken url <<< Just
118

119
post :: forall a b. JSON.WriteForeign a => JSON.ReadForeign b => Maybe Token -> String -> a -> AffRESTError b
120
post mtoken url = send POST mtoken url <<< Just
121

122 123
type FormDataParams = Array (Tuple String (Maybe String))

124
-- TODO too much duplicate code with `send`
125
postWwwUrlencoded :: forall b. JSON.ReadForeign b => Maybe Token -> String -> FormDataParams -> AffRESTError b
126
postWwwUrlencoded mtoken url bodyParams = do
127 128 129 130
  affResp <- request $ defaultRequest
             { url = url
             , responseFormat = ResponseFormat.json
             , method = Left POST
131 132
             , headers =  [ ARH.ContentType applicationFormURLEncoded
                          , ARH.Accept applicationJSON
133 134
                          ] <>
                          foldMap (\token ->
135
                            [ARH.RequestHeader "Authorization" $  "Bearer " <> token]
136
                          ) mtoken
137
             , content  = Just $ formURLEncoded urlEncodedBody
138
             }
139
  pure $ readJSON affResp
140
  where
141
    urlEncodedBody = FormURLEncoded.fromArray bodyParams
142

143
postMultipartFormData :: forall b. JSON.ReadForeign b => Maybe Token -> String -> String -> AffRESTError b
144 145 146 147 148 149 150
postMultipartFormData mtoken url body = do
  fd <- liftEffect $ XHRFormData.new
  _ <- liftEffect $ XHRFormData.append (XHRFormData.EntryName "body") body fd
  affResp <- request $ defaultRequest
             { url = url
             , responseFormat = ResponseFormat.json
             , method = Left POST
151 152
             , headers = [ ARH.ContentType multipartFormData
                         , ARH.Accept applicationJSON
153 154
                         ] <>
                         foldMap (\token ->
155
                           [ ARH.RequestHeader "Authorization" $ " " <> token ]
156 157 158
                         ) mtoken
             , content = Just $ formData fd
             }
159
  pure $ readJSON affResp