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
module Gargantext.Utils.CacheAPI where
import Gargantext.Prelude hiding (add)
import Control.Monad.Except (runExcept)
import Control.Promise (Promise, toAffE)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))
import Effect (Effect)
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Foreign as F
import Foreign.Object as O
import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Sessions (Session(..))
import Milkis as M
import Simple.JSON as JSON
import Type.Row (class Union)
foreign import data Cache :: Type
foreign import data Request :: Type
newtype CacheName = CacheName String
type Token = String
makeRequest :: forall options trash. Union options trash M.Options =>
M.URL -> { method :: M.Method, headers :: M.Headers | options } -> Request
makeRequest url options = _makeRequest url options
makeTokenRequest :: forall options trash. Union options trash M.Options =>
M.URL -> Maybe Token -> { method :: M.Method, headers :: M.Headers | options } -> Request
makeTokenRequest url mToken options = case mToken of
Nothing -> makeRequest url $ options { headers = mkHeaders O.empty }
Just t -> makeRequest url $ options { headers = mkHeaders $ O.singleton "Authorization" $ "Bearer " <> t }
where
defaultOptions = O.fromFoldable [ Tuple "Accept" "application/json"
, Tuple "Content-Type" "application/json" ]
mkHeaders t = O.unions [ options.headers, defaultOptions, t ]
makeGetRequest :: forall p. ToUrl Session p => Session -> p -> Request
makeGetRequest session@(Session { token }) p = makeTokenRequest url (Just token) { method, headers: O.empty }
where
method = M.getMethod
url = M.URL $ toUrl session p
openCache :: CacheName -> Aff Cache
openCache (CacheName cacheName) = toAffE $ _openCache cacheName
delete :: CacheName -> Aff Unit
delete (CacheName cacheName) = toAffE $ _delete cacheName
add :: Cache -> Request -> Aff Unit
add cache req = toAffE $ _add cache req
match :: Cache -> Request -> Aff (Maybe M.Response)
match cache req = do
res <- toAffE $ _match cache req
-- _match returns a null/undefined value when cache entity not found
case runExcept $ F.readNullOrUndefined res of
Left err -> throwError $ error $ show err
Right v -> pure $ F.unsafeFromForeign <$> v
cached :: Cache -> Request -> Aff M.Response
cached cache req = do
mRes <- match cache req
case mRes of
Just res -> do
-- liftEffect $ log2 "[cached] cache hit" req
pure res
Nothing -> do
-- liftEffect $ log2 "[cached] cache miss" req
_ <- add cache req
mResFresh <- match cache req
case mResFresh of
Just res -> pure res
Nothing -> throwError $ error $ "[cached] Cannot add to cache"
cachedJson :: forall a. JSON.ReadForeign a => Cache -> Request -> Aff a
cachedJson cache req = do
res <- cached cache req
-- liftEffect $ do
-- log2 "[cachedJson] res" res
j <- M.text res
case JSON.readJSON j of
Left err -> throwError $ error $ "[cachedJson] decodeJson affResp.body: " <> show err
Right b -> pure b
deleteReq :: Cache -> Request -> Aff Unit
deleteReq cache req = toAffE $ _deleteReq cache req
-- No cache: raw API calls
fetch :: Request -> Aff M.Response
fetch req = do
res <- toAffE $ _fetch req
pure $ F.unsafeFromForeign res
pureJson :: forall a. JSON.ReadForeign a => Request -> Aff a
pureJson req = do
res <- fetch req
j <- M.text res
case JSON.readJSON j of
Left err -> throwError $ error $ "[pureJson] decodeJson affResp.body: " <> show err
Right b -> pure b
foreign import _makeRequest :: forall options.
M.URL -> { method :: M.Method, headers :: M.Headers | options } -> Request
foreign import _openCache :: String -> Effect (Promise Cache)
foreign import _delete :: String -> Effect (Promise Unit)
foreign import _deleteReq :: Cache -> Request -> Effect (Promise Unit)
foreign import _add :: Cache -> Request -> Effect (Promise Unit)
foreign import _match :: Cache -> Request -> Effect (Promise F.Foreign)
foreign import _fetch :: Request -> Effect (Promise F.Foreign)