CacheAPI.purs 4.72 KB
Newer Older
1 2
module Gargantext.Utils.CacheAPI where

3
import Control.Monad.Except (runExcept)
4
import Control.Promise (Promise, toAffE)
5 6 7 8
import Data.Argonaut (class DecodeJson, decodeJson, class EncodeJson, encodeJson, (:=), (~>), (.:), fromString)
import Data.Either (Either(..))
import Data.Function.Uncurried (Fn3)
import Data.Maybe (Maybe(..))
9
import Data.Tuple (Tuple(..))
10
import DOM.Simple.Console (log2)
11
import Effect (Effect)
12
import Effect.Aff (Aff, throwError)
13
import Effect.Aff.Compat (EffectFnAff, fromEffectFnAff)
14 15 16 17
import Effect.Class (liftEffect)
import Effect.Exception (error)
import Foreign as F
import Foreign.Object as O
18 19 20 21
import Milkis as M
import Type.Row (class Union)

import Gargantext.Prelude
22 23 24 25 26 27 28 29 30 31 32 33
import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Sessions (Session(..))


get :: forall a p. DecodeJson a => ToUrl Session p => Cache -> Session -> p -> Aff a
get cache session p = do
  let req = makeGetRequest session p
  res <- cached cache req

  j <- M.json res

  case decodeJson (F.unsafeFromForeign j) of
34
    Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
35
    Right b -> pure b
36 37 38 39 40

foreign import data Cache :: Type
foreign import data Request :: Type

newtype CacheName = CacheName String
41
type Token = String
42 43

makeRequest :: forall options trash. Union options trash M.Options =>
44
               M.URL -> { method :: M.Method, headers :: M.Headers | options } -> Request
45 46
makeRequest url options = _makeRequest url options

47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62
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

63 64 65
openCache :: CacheName -> Aff Cache
openCache (CacheName cacheName) = toAffE $ _openCache cacheName

66 67 68
delete :: CacheName -> Aff Unit
delete (CacheName cacheName) = toAffE $ _delete cacheName

69 70 71 72 73 74
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
75
  -- _match returns a null/undefined value when cache entity not found
76 77 78 79
  case runExcept $ F.readNullOrUndefined res of
    Left err -> throwError $ error $ show err
    Right v -> pure $ F.unsafeFromForeign <$> v

80
cached :: Cache -> Request -> Aff M.Response
81 82 83 84
cached cache req = do
  mRes <- match cache req
  case mRes of
    Just res -> do
85
      -- liftEffect $ log2 "[cached] cache hit" req
86 87
      pure res
    Nothing -> do
88
      -- liftEffect $ log2 "[cached] cache miss" req
89 90 91 92 93 94 95 96 97
      _ <- add cache req
      mResFresh <- match cache req
      case mResFresh of
        Just res -> pure res
        Nothing -> throwError $ error $ "Cannot add to cache"

cachedJson :: forall a. DecodeJson a => Cache -> Request -> Aff a
cachedJson cache req = do
  res <- cached cache req
98 99
  -- liftEffect $ do
  --   log2 "[cachedJson] res" res
100 101 102
  j <- M.json res

  case decodeJson (F.unsafeFromForeign j) of
103
    Left err -> throwError $ error $ "[cachedJson] decodeJson affResp.body: " <> show err
104
    Right b -> pure b
105

106 107
deleteReq :: Cache -> Request -> Aff Unit
deleteReq cache req = toAffE $ _deleteReq cache req
108

109 110 111 112 113 114 115 116 117 118 119 120 121

-- No cache: raw API calls

fetch :: Request -> Aff M.Response
fetch req = do
  res <- toAffE $ _fetch req
  pure $ F.unsafeFromForeign res

pureJson :: forall a. DecodeJson a => Request -> Aff a
pureJson req = do
  res <- fetch req
  j <- M.json res
  case decodeJson (F.unsafeFromForeign j) of
122
    Left err -> throwError $ error $ "[pureJson] decodeJson affResp.body: " <> show err
123 124 125
    Right b -> pure b


126
foreign import _makeRequest :: forall options trash. Union options trash M.Options =>
127
                               M.URL -> { method :: M.Method, headers :: M.Headers | options } -> Request
128
foreign import _openCache :: String -> Effect (Promise Cache)
129 130
foreign import _delete :: String -> Effect (Promise Unit)
foreign import _deleteReq :: Cache -> Request -> Effect (Promise Unit)
131 132
foreign import _add :: Cache -> Request -> Effect (Promise Unit)
foreign import _match :: Cache -> Request -> Effect (Promise F.Foreign)
133
foreign import _fetch :: Request -> Effect (Promise F.Foreign)