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

3
import Control.Monad.Except (runExcept)
4
import Control.Promise (Promise, toAffE)
5
import Data.Argonaut (class DecodeJson, decodeJson)
6 7
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
8 9
import Data.Tuple (Tuple(..))
import Effect (Effect)
10 11 12 13
import Effect.Aff (Aff, throwError)
import Effect.Exception (error)
import Foreign as F
import Foreign.Object as O
14 15 16
import Milkis as M
import Type.Row (class Union)

17
import Gargantext.Prelude hiding (add)
18 19 20 21 22 23 24 25 26 27 28 29
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
30
    Left err -> throwError $ error $ "decodeJson affResp.body: " <> show err
31
    Right b -> pure b
32 33 34 35 36

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

newtype CacheName = CacheName String
37
type Token = String
38 39

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

43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58
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

59 60 61
openCache :: CacheName -> Aff Cache
openCache (CacheName cacheName) = toAffE $ _openCache cacheName

62 63 64
delete :: CacheName -> Aff Unit
delete (CacheName cacheName) = toAffE $ _delete cacheName

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

76
cached :: Cache -> Request -> Aff M.Response
77 78 79 80
cached cache req = do
  mRes <- match cache req
  case mRes of
    Just res -> do
81
      -- liftEffect $ log2 "[cached] cache hit" req
82 83
      pure res
    Nothing -> do
84
      -- liftEffect $ log2 "[cached] cache miss" req
85 86 87 88 89 90 91 92 93
      _ <- 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
94 95
  -- liftEffect $ do
  --   log2 "[cachedJson] res" res
96 97 98
  j <- M.json res

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

102 103
deleteReq :: Cache -> Request -> Aff Unit
deleteReq cache req = toAffE $ _deleteReq cache req
104

105 106 107 108 109 110 111 112 113 114 115 116 117

-- 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
118
    Left err -> throwError $ error $ "[pureJson] decodeJson affResp.body: " <> show err
119 120 121
    Right b -> pure b


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