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

Sudhir Kumar's avatar
Sudhir Kumar committed
3
import Affjax (defaultRequest, printResponseFormatError, request)
4
import Affjax.RequestBody (RequestBody(..), formData, formURLEncoded, string)
5
import Affjax.RequestHeader as ARH
Sudhir Kumar's avatar
Sudhir Kumar committed
6
import Affjax.ResponseFormat as ResponseFormat
7
import DOM.Simple.Console (log)
8
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson)
9
import Data.Array as A
10
import Data.Either (Either(..))
11 12
import Data.Foldable (foldMap)
import Data.FormURLEncoded as FormURLEncoded
Sudhir Kumar's avatar
Sudhir Kumar committed
13
import Data.HTTP.Method (Method(..))
14
import Data.Maybe (Maybe(..))
15 16
import Data.MediaType.Common (applicationFormURLEncoded, applicationJSON, multipartFormData)
import Data.Tuple (Tuple(..))
17
import Effect.Aff (Aff, throwError)
18
import Effect.Class (liftEffect)
19
import Effect.Exception (error)
20
import Web.XHR.FormData as XHRFormData
21

22 23 24
import Gargantext.Prelude
import Gargantext.Utils.Reactix as R2

25 26 27
type Token = String

-- TODO too much duplicate code in `postWwwUrlencoded`
28
send :: forall a b. EncodeJson a => DecodeJson b =>
29 30
        Method -> Maybe Token -> String -> Maybe a -> Aff b
send m mtoken url reqbody = do
31 32 33 34
  affResp <- request $ defaultRequest
         { url = url
         , responseFormat = ResponseFormat.json
         , method = Left m
35 36
         , headers =  [ ARH.ContentType applicationJSON
                      , ARH.Accept applicationJSON
37 38
                      ] <>
                      foldMap (\token ->
39
                        [ARH.RequestHeader "Authorization" $  "Bearer " <> token]
40
                      ) mtoken
41 42
         , content  = (Json <<< encodeJson) <$> reqbody
         }
43 44 45 46 47
  case mtoken of
    Nothing -> pure unit
    Just token -> liftEffect $ do
      let cookie = "JWT-Cookie=" <> token <> "; Path=/;" --" HttpOnly; Secure; SameSite=Lax"
      R2.setCookie cookie
Sudhir Kumar's avatar
Sudhir Kumar committed
48
  case affResp.body of
49
    Left err -> do
50
      _ <-  liftEffect $ log $ printResponseFormatError err
51 52
      throwError $ error $ printResponseFormatError err
    Right json -> do
53 54 55
      --_ <-  liftEffect $ log json.status
      --_ <-  liftEffect $ log json.headers
      --_ <-  liftEffect $ log json.body
56 57 58 59 60 61 62
      case decodeJson json of
        Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
        Right b -> pure b

noReqBody :: Maybe Unit
noReqBody = Nothing

63 64
get :: forall a. DecodeJson a => Maybe Token -> String -> Aff a
get mtoken url = send GET mtoken url noReqBody
65

66 67
put :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
put mtoken url = send PUT mtoken url <<< Just
68

69 70
delete :: forall a. DecodeJson a => Maybe Token -> String -> Aff a
delete mtoken url = send DELETE mtoken url noReqBody
71

72 73
-- This might not be a good idea:
-- https://stackoverflow.com/questions/14323716/restful-alternatives-to-delete-request-body
74 75
deleteWithBody :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
deleteWithBody mtoken url = send DELETE mtoken url <<< Just
76

77 78
post :: forall a b. EncodeJson a => DecodeJson b => Maybe Token -> String -> a -> Aff b
post mtoken url = send POST mtoken url <<< Just
79

80 81
type FormDataParams = Array (Tuple String (Maybe String))

82
-- TODO too much duplicate code with `send`
83 84
postWwwUrlencoded :: forall b. DecodeJson b => Maybe Token -> String -> FormDataParams -> Aff b
postWwwUrlencoded mtoken url bodyParams = do
85 86 87 88
  affResp <- request $ defaultRequest
             { url = url
             , responseFormat = ResponseFormat.json
             , method = Left POST
89 90
             , headers =  [ ARH.ContentType applicationFormURLEncoded
                          , ARH.Accept applicationJSON
91 92
                          ] <>
                          foldMap (\token ->
93
                            [ARH.RequestHeader "Authorization" $  "Bearer " <> token]
94
                          ) mtoken
95
             , content  = Just $ formURLEncoded urlEncodedBody
96 97 98
             }
  case affResp.body of
    Left err -> do
99
      _ <-  liftEffect $ log $ printResponseFormatError err
100 101
      throwError $ error $ printResponseFormatError err
    Right json -> do
102 103 104
      --_ <- liftEffect $ log json.status
      --_ <- liftEffect $ log json.headers
      --_ <- liftEffect $ log json.body
105 106 107
      case decodeJson json of
        Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
        Right b -> pure b
108
  where
109
    urlEncodedBody = FormURLEncoded.fromArray bodyParams
110 111 112 113 114 115 116 117 118

postMultipartFormData :: forall b. DecodeJson b => Maybe Token -> String -> String -> Aff b
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
119 120
             , headers = [ ARH.ContentType multipartFormData
                         , ARH.Accept applicationJSON
121 122
                         ] <>
                         foldMap (\token ->
123
                           [ ARH.RequestHeader "Authorization" $ "Bearer " <> token ]
124 125 126 127 128 129 130 131 132 133 134
                         ) mtoken
             , content = Just $ formData fd
             }
  case affResp.body of
    Left err -> do
      _ <-  liftEffect $ log $ printResponseFormatError err
      throwError $ error $ printResponseFormatError err
    Right json -> do
      case decodeJson json of
        Left err -> throwError $ error $ "decodeJson affResp.body: " <> err
        Right b -> pure b