diff options
Diffstat (limited to 'backend')
| -rw-r--r-- | backend/app/Main.hs | 19 | ||||
| -rw-r--r-- | backend/lib/ACMS/API/REST.hs | 8 | ||||
| -rw-r--r-- | backend/lib/ACMS/API/REST/Collection.hs | 8 |
3 files changed, 18 insertions, 17 deletions
diff --git a/backend/app/Main.hs b/backend/app/Main.hs index 8070906..c31ea7d 100644 --- a/backend/app/Main.hs +++ b/backend/app/Main.hs @@ -285,6 +285,8 @@ queryApi root ref repoT app req resp = do q <- fromString @Q.Query . LB.toString <$> W.lazyRequestBody req resp . W.responseLBS W.status200 [] . J.encode =<< Q.withStore root ref do Q.query q + _ -> do + error "not implemented" _ -> app req resp restApi :: FilePath -> T.Text -> TMVar Repo -> W.Middleware @@ -311,9 +313,11 @@ restApi root ref repoT app req resp = do resp . W.responseLBS W.status200 [] $ J.encode (map (.path) lastCompatibleCommit.collections) ("GET", ["collection", T.unpack -> c, "schema"]) -> do - let [collection] = filter ((== c) . (.path)) lastCompatibleCommit.collections - resp . W.responseLBS W.status200 [] $ - J.encode (fromAutoTypes c collection.schema) + case find ((== c) . (.path)) lastCompatibleCommit.collections of + Nothing -> error "not implemented" + Just collection -> + resp . W.responseLBS W.status200 [] $ + J.encode (fromAutoTypes c collection.schema) ("POST", ["collection"]) -> do when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented" Right collection <- J.eitherDecode <$> W.lazyRequestBody req @@ -327,16 +331,17 @@ restApi root ref repoT app req resp = do Q.query (fromString (printf "SELECT %s FROM %s" c c)) ) ("GET", ["collection", c, i]) -> do - resp . W.responseLBS W.status200 [] . J.encode + resp . W.responseLBS W.status200 [] . J.encode . headMay =<< ( Q.withStore root ref $ Q.withCommit rev do Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) ) ("PUT", ["collection", c, i]) -> do when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented" o <- J.throwDecode @J.Object =<< W.lazyRequestBody req - resp . W.responseLBS W.status200 [] . J.encode + resp . W.responseLBS W.status200 [] . J.encode . headMay =<< ( Q.withStore root ref do Q.query (fromString (printf "UPDATE %s SET %s WHERE %s.$fileName == \"%s\"" c (LB.toString (J.encode o)) c i)) + Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) ) ("POST", ["collection", c]) -> do when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented" @@ -349,9 +354,11 @@ restApi root ref repoT app req resp = do ) ("DELETE", ["collection", c, i]) -> do when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented" - resp . W.responseLBS W.status200 [] . J.encode + resp . W.responseLBS W.status200 [] . J.encode . headMay =<< ( Q.withStore root ref do + r <- Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) Q.query (fromString (printf "DELETE FROM %s WHERE %s.$fileName == \"%s\"" c c i)) + pure r ) (method, path) -> fail $ "Method " ++ show method ++ " on route " ++ show path ++ " not supported." _ -> app req resp diff --git a/backend/lib/ACMS/API/REST.hs b/backend/lib/ACMS/API/REST.hs index 64b47b7..ec72db9 100644 --- a/backend/lib/ACMS/API/REST.hs +++ b/backend/lib/ACMS/API/REST.hs @@ -13,19 +13,15 @@ import Miso.String qualified as J #endif import Control.Monad.Catch (MonadThrow) import Data.Aeson qualified as A -import Data.ByteString.Char8 qualified as B import Data.ByteString.Lazy.Char8 qualified as LB import Data.Function ((&)) +import Data.String (IsString (fromString)) import Miso (JSM) import Miso.String (MisoString) restRequest :: String -> Request restRequest endpoint = - defaultRequest - & setRequestSecure False - & setRequestHost "localhost" - & setRequestPort 8081 - & setRequestPath ("/api/rest" <> B.pack endpoint) + fromString ("http://localhost:8081/api/rest/" <> endpoint) schemaVersion :: (APIMonad m, A.FromJSON a) => m a schemaVersion = diff --git a/backend/lib/ACMS/API/REST/Collection.hs b/backend/lib/ACMS/API/REST/Collection.hs index 3ca8ffd..b3faf19 100644 --- a/backend/lib/ACMS/API/REST/Collection.hs +++ b/backend/lib/ACMS/API/REST/Collection.hs @@ -11,12 +11,10 @@ import Data.Maybe import JavaScript.Web.XMLHttpRequest import Miso.String qualified as J #endif -import Collection import ACMS.API.REST (APIMonad, fetch, restRequest) +import Collection import Data.Aeson qualified as A import Data.Function ((&)) -import Debug.Trace -import Miso.String (MisoString) import Text.Printf (printf) list :: (APIMonad m) => Collection -> m [A.Object] @@ -25,7 +23,7 @@ list c = & fetch >>= A.throwDecode -read :: (APIMonad m) => CollectionItem -> m [A.Object] +read :: (APIMonad m) => CollectionItem -> m (Maybe A.Object) read ci = restRequest (printf "/collection/%s/%s" ci.collection.name ci.itemFileName) & fetch @@ -47,7 +45,7 @@ create c o = do & fetch >>= A.throwDecode -delete :: (APIMonad m) => CollectionItem -> m [A.Object] +delete :: (APIMonad m) => CollectionItem -> m A.Object delete ci = restRequest (printf "/collection/%s/%s" ci.collection.name ci.itemFileName) & setRequestMethod "DELETE" |