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

3 4
import Gargantext.Prelude hiding (add)

5
import Control.Monad.Except (runExcept)
6
import Control.Promise (Promise, toAffE)
7 8
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
9 10
import Data.Tuple (Tuple(..))
import Effect (Effect)
11 12 13 14
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Foreign as F
import Foreign.Object as O
15 16
import Gargantext.Ends (class ToUrl, toUrl)
import Gargantext.Sessions (Session(..))
17
import Milkis as M
18
import Simple.JSON as JSON
19 20 21 22 23 24 25
import Type.Row (class Union)


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

newtype CacheName = CacheName String
26
type Token = String
27 28

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

32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47
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

48 49 50
openCache :: CacheName -> Aff Cache
openCache (CacheName cacheName) = toAffE $ _openCache cacheName

51 52 53
delete :: CacheName -> Aff Unit
delete (CacheName cacheName) = toAffE $ _delete cacheName

54 55 56 57 58 59
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
60
  -- _match returns a null/undefined value when cache entity not found
61 62 63 64
  case runExcept $ F.readNullOrUndefined res of
    Left err -> throwError $ error $ show err
    Right v -> pure $ F.unsafeFromForeign <$> v

65
cached :: Cache -> Request -> Aff M.Response
66 67 68 69
cached cache req = do
  mRes <- match cache req
  case mRes of
    Just res -> do
70
      -- liftEffect $ log2 "[cached] cache hit" req
71 72
      pure res
    Nothing -> do
73
      -- liftEffect $ log2 "[cached] cache miss" req
74 75 76 77
      _ <- add cache req
      mResFresh <- match cache req
      case mResFresh of
        Just res -> pure res
78
        Nothing -> throwError $ error $ "[cached] Cannot add to cache"
79

80
cachedJson :: forall a. JSON.ReadForeign a => Cache -> Request -> Aff a
81 82
cachedJson cache req = do
  res <- cached cache req
83 84
  -- liftEffect $ do
  --   log2 "[cachedJson] res" res
85
  j <- M.text res
86

87
  case JSON.readJSON j of
88
    Left err -> throwError $ error $ "[cachedJson] decodeJson affResp.body: " <> show err
89
    Right b -> pure b
90

91 92
deleteReq :: Cache -> Request -> Aff Unit
deleteReq cache req = toAffE $ _deleteReq cache req
93

94 95 96 97 98 99 100 101

-- No cache: raw API calls

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

102
pureJson :: forall a. JSON.ReadForeign a => Request -> Aff a
103 104
pureJson req = do
  res <- fetch req
105 106
  j <- M.text res
  case JSON.readJSON j of
107
    Left err -> throwError $ error $ "[pureJson] decodeJson affResp.body: " <> show err
108 109 110
    Right b -> pure b


111
foreign import _makeRequest :: forall options.
112
                               M.URL -> { method :: M.Method, headers :: M.Headers | options } -> Request
113
foreign import _openCache :: String -> Effect (Promise Cache)
114 115
foreign import _delete :: String -> Effect (Promise Unit)
foreign import _deleteReq :: Cache -> Request -> Effect (Promise Unit)
116 117
foreign import _add :: Cache -> Request -> Effect (Promise Unit)
foreign import _match :: Cache -> Request -> Effect (Promise F.Foreign)
118
foreign import _fetch :: Request -> Effect (Promise F.Foreign)