diff options
| -rw-r--r-- | backend/app/Main.hs | 91 | ||||
| -rw-r--r-- | backend/backend.cabal | 3 | ||||
| -rw-r--r-- | common/src/Collection.hs | 5 | ||||
| -rw-r--r-- | default.nix | 1 | ||||
| -rw-r--r-- | docs/api-reference.md | 36 | ||||
| -rw-r--r-- | docs/get-started-cli.md | 8 | ||||
| -rw-r--r-- | frontend/app/Schema.hs | 2 |
7 files changed, 88 insertions, 58 deletions
diff --git a/backend/app/Main.hs b/backend/app/Main.hs index 2b461e5..c9db2ea 100644 --- a/backend/app/Main.hs +++ b/backend/app/Main.hs @@ -177,7 +177,10 @@ initRepo root ref = do J.Array (V.toList -> (value : values)) <- do liftIO . Q.withStore root ref . Q.withCommit cid $ do Q.query (fromString ("SELECT " <> path <> " FROM " <> path)) - let schema = U.autoTypes' value values + let schema = + U.autoTypes' + (fileNameToId value) + (fileNameToId <$> values) pure $ Collection path files schema refMap <- liftIO . Q.withStore root ref . Q.withCommit cid $ do buildRefMap @@ -262,7 +265,10 @@ instance Exception ReferenceViolation buildRefMap :: Q.StoreM RefMap buildRefMap = do - allFiles <- S.fromList <$> Q.listFiles "" + allIds <- + S.fromList + . map ((,) <$> takeDirectory <*> (dropExtension . takeBaseName)) + <$> Q.listFiles "" refMap <- foldl' ( \refMap (referencee, reference) -> @@ -274,12 +280,12 @@ buildRefMap = do (RefMap M.empty M.empty) . concat <$> mapM - ( \filePath -> do - v@(J.Object _) <- Q.readFile @J.Value filePath - pure (map (filePath,) (collectReferences v)) + ( \(c, i) -> do + v@(J.Object _) <- head <$> Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE (T.pack i)))) + pure (map (c </> i,) (collectReferences v)) ) - (S.toList allFiles) - checkRefMap allFiles refMap + (S.toList allIds) + checkRefMap allIds refMap pure refMap where collectReferences (J.Object kvs) = @@ -289,10 +295,10 @@ buildRefMap = do collectReferences (J.Array vs) = concatMap collectReferences vs collectReferences _ = [] - checkRefMap allFiles (RefMap {referencees}) = do + checkRefMap allIds (RefMap {referencees}) = do mapM_ ( \(reference, referencees) -> - when (not (reference `S.member` allFiles)) do + when (not (reference `S.member` S.map (uncurry (</>)) allIds)) do liftIO (throwIO (ReferenceViolation reference referencees)) ) (M.toList referencees) @@ -359,8 +365,8 @@ queryApi root ref repoT app req resp = do when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented" q <- fromString @Q.Query . LB.toString <$> W.lazyRequestBody req - resp . W.responseLBS W.status200 [] . J.encode - =<< Q.withStore root ref do Q.query q + resp . W.responseLBS W.status200 [] . J.encode . fileNameToId + =<< Q.withStore root ref do Q.query @J.Value q _ -> do error "not implemented" _ -> app req resp @@ -402,14 +408,14 @@ restApi root ref repoT app req resp = do Q.commit resp $ W.responseLBS W.status200 [] "{}" ("GET", ["collection", c]) -> do - resp . W.responseLBS W.status200 [] . J.encode + resp . W.responseLBS W.status200 [] . J.encode . fileNameToId =<< ( Q.withStore root ref $ Q.withCommit rev do - Q.query (fromString (printf "SELECT %s FROM %s" c c)) + Q.query @J.Value (fromString (printf "SELECT %s FROM %s" c c)) ) ("GET", ["collection", c, "paginated", read @Int . T.unpack -> limit, read @Int . T.unpack -> offset]) -> do - resp . W.responseLBS W.status200 [] . J.encode + resp . W.responseLBS W.status200 [] . J.encode . fileNameToId =<< ( Q.withStore root ref $ Q.withCommit rev do - Q.query + Q.query @J.Value ( fromString ( printf "SELECT %s FROM %s%s%s" @@ -421,37 +427,37 @@ restApi root ref repoT app req resp = do ) ) ("GET", ["collection", c, i]) -> do - resp . W.responseLBS W.status200 [] . J.encode . arrayHead + resp . W.responseLBS W.status200 [] . J.encode . fileNameToId . head =<< ( Q.withStore root ref $ Q.withCommit rev do - Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) + Q.query @[J.Value] (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE 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 . arrayHead + resp . W.responseLBS W.status200 [] . J.encode . fileNameToId . head =<< ( 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)) - J.Array (V.toList -> [J.Object r]) <- Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) - _ <- Q.query (fromString (printf "INSERT %s INTO %s" (LB.toString (J.encode (dropNulls r))) c)) + _ <- Q.query @J.Value (fromString (printf "UPDATE %s SET %s WHERE %s.$fileName =~ /^%s\\.json$/" c (LB.toString (J.encode o)) c (escapePCRE i))) + J.Array (V.toList -> [J.Object r]) <- Q.query @J.Value (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE i))) + _ <- Q.query @J.Value (fromString (printf "INSERT %s INTO %s" (LB.toString (J.encode (dropNulls r))) c)) _ <- buildRefMap - Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) + Q.query @[J.Value] (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE i))) ) ("POST", ["collection", c]) -> do when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented" - i <- ((<> ".json") . U.toText) <$> getUUID + i <- U.toText <$> getUUID o <- fmap dropNulls . J.throwDecode @J.Object =<< W.lazyRequestBody req - resp . W.responseLBS W.status200 [] . J.encode . arrayHead + resp . W.responseLBS W.status200 [] . J.encode . fileNameToId . head =<< ( Q.withStore root ref do - _ <- Q.query (fromString (printf "INSERT %s INTO %s" (LB.toString (J.encode (JM.insert "$fileName" (J.String i) o))) c)) + _ <- Q.query @J.Value (fromString (printf "INSERT %s INTO %s" (LB.toString (J.encode (JM.insert "$fileName" (J.String (i <> ".json")) o))) c)) _ <- buildRefMap - Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i)) + Q.query @[J.Value] (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE i))) ) ("DELETE", ["collection", c, i]) -> do when (not (sameCommit lastCompatibleCommit lastCommit)) $ error "not implemented" - resp . W.responseLBS W.status200 [] . J.encode . arrayHead + resp . W.responseLBS W.status200 [] . J.encode . fileNameToId . head =<< ( 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)) + r <- Q.query @[J.Value] (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c c (escapePCRE i))) + Q.query @J.Value (fromString (printf "DELETE FROM %s WHERE %s.$fileName =~ /^%s\\.json$/" c c (escapePCRE i))) _ <- buildRefMap pure r ) @@ -477,5 +483,28 @@ dropNulls = _ -> Just v ) -arrayHead :: J.Value -> J.Value -arrayHead (J.Array v) = V.head v +escapePCRE :: T.Text -> T.Text +escapePCRE = T.pack . escapePCRE' . T.unpack + +escapePCRE' :: String -> String +escapePCRE' [] = [] +escapePCRE' (c : cs) = + ((if c `elem` (".^$*+?()[{\\|" :: String) then ('\\' :) else id) [c]) + <> escapePCRE' cs + +fileNameToId :: J.Value -> J.Value +fileNameToId (J.Array xs) = J.Array (V.map fileNameToId xs) +fileNameToId (J.Object kvs) = + J.Object + ( JM.foldrWithKey + ( \k v -> + case (k, v) of + ("$fileName", J.String v) -> + JM.insert "$id" (J.String (T.pack (dropExtension (T.unpack v)))) + _ -> + JM.insert k (fileNameToId v) + ) + JM.empty + $ kvs + ) +fileNameToId v = v diff --git a/backend/backend.cabal b/backend/backend.cabal index 5286cc8..335e8f3 100644 --- a/backend/backend.cabal +++ b/backend/backend.cabal @@ -66,6 +66,9 @@ executable backend non-empty, optparse-applicative, random, + regex, + regex-base, + regex-pcre, safe, split, stm, diff --git a/common/src/Collection.hs b/common/src/Collection.hs index 25cdec7..418278d 100644 --- a/common/src/Collection.hs +++ b/common/src/Collection.hs @@ -22,10 +22,7 @@ instance Read CollectionItem where readPrec = R.lift $ do (Collection . toMisoString -> collection) <- R.munch (/= '/') _ <- R.string "/" - itemFileName <- do - itemFileName <- R.munch (liftA2 (&&) (/= '.') (/= '/')) - fileExt <- R.string ".json" - pure (itemFileName <> fileExt) + itemFileName <- R.munch (const True) pure CollectionItem {..} instance Show CollectionItem where diff --git a/default.nix b/default.nix index 9e66c80..7712bd6 100644 --- a/default.nix +++ b/default.nix @@ -23,6 +23,7 @@ rec { haskellPackages.cabal-install haskellPackages.haskell-language-server haskellPackages.ormolu + pkgs.pkg-config pkgs.niv (pkgs.writeScriptBin "reload" '' set -efu diff --git a/docs/api-reference.md b/docs/api-reference.md index 248ab8c..fd09ecc 100644 --- a/docs/api-reference.md +++ b/docs/api-reference.md @@ -17,11 +17,11 @@ curl -X POST http://localhost:8081/api/rest/collection/entity --data @- <<'EOF' EOF ``` -Note that the created entity is returned, including the meta field `$fileName`. +Note that the created entity is returned, including the meta field `$id`. ```json { - "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json", + "$id": "9474f0eb-06d7-4fd8-b89e-0ce996962508", "description": "Description of entity 1", "name": "Entity 1" } @@ -40,7 +40,7 @@ EOF ```json { - "$fileName": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json", + "$id": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b", "description": "Description of entity 2", "name": "Entity 2" } @@ -61,7 +61,7 @@ As one would expect, the schema lists the fields `name`, `description` as requir "$id": "entity.schema.json", "$schema": "https://json-schema.org/draft/2020-12/schema", "properties": { - "$fileName": { + "$id": { "type": "string" }, "description": { @@ -72,7 +72,7 @@ As one would expect, the schema lists the fields `name`, `description` as requir } }, "required": [ - "$fileName", + "$id", "description", "name" ], @@ -83,15 +83,15 @@ As one would expect, the schema lists the fields `name`, `description` as requir ### Retrieving a single collection entity -Single collection entities can be retrieved using their unique `$fileName` identifier. +Single collection entities can be retrieved using their unique `$id` identifier. ```console -curl http://localhost:8081/api/rest/collection/entity/9474f0eb-06d7-4fd8-b89e-0ce996962508.json | jq . +curl http://localhost:8081/api/rest/collection/entity/9474f0eb-06d7-4fd8-b89e-0ce996962508 | jq . ``` ```json { - "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json", + "$id": "9474f0eb-06d7-4fd8-b89e-0ce996962508", "description": "Description of entity 1", "name": "Entity 1" } @@ -108,12 +108,12 @@ curl http://localhost:8081/api/rest/collection/entity | jq . ```json [ { - "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json", + "$id": "9474f0eb-06d7-4fd8-b89e-0ce996962508", "description": "Description of entity 1", "name": "Entity 1" }, { - "$fileName": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json", + "$id": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b", "description": "Description of entity 2", "name": "Entity 2" } @@ -125,7 +125,7 @@ curl http://localhost:8081/api/rest/collection/entity | jq . Updating a collection entity is possible by send only select fields. ```console -curl -X PUT http://localhost:8081/api/rest/collection/entity/ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json --data @- <<'EOF' | jq . +curl -X PUT http://localhost:8081/api/rest/collection/entity/ccccc18c-f3dc-4f98-b4d2-290ef76adb6b --data @- <<'EOF' | jq . { "description": "Entity 2 description" } @@ -136,7 +136,7 @@ The endpoint returns the full, updated entity. ```json { - "$fileName": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json", + "$id": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b", "description": "Entity 2 description", "name": "Entity 2" } @@ -145,7 +145,7 @@ The endpoint returns the full, updated entity. Fields can be deleted setting them their values to `null`. ```console -curl -X PUT http://localhost:8081/api/rest/collection/entity/ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json --data @- <<'EOF' | jq . +curl -X PUT http://localhost:8081/api/rest/collection/entity/ccccc18c-f3dc-4f98-b4d2-290ef76adb6b --data @- <<'EOF' | jq . { "description": null } @@ -156,7 +156,7 @@ Again, the response contains the full entity after the update. ```json { - "$fileName": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b.json", + "$id": "ccccc18c-f3dc-4f98-b4d2-290ef76adb6b", "name": "Entity 2" } ``` @@ -176,7 +176,7 @@ curl http://localhost:8081/api/rest/collection/entity/schema | jq . "$id": "entity.schema.json", "$schema": "https://json-schema.org/draft/2020-12/schema", "properties": { - "$fileName": { + "$id": { "type": "string" }, "description": { @@ -187,7 +187,7 @@ curl http://localhost:8081/api/rest/collection/entity/schema | jq . } }, "required": [ - "$fileName", + "$id", "name" ], "title": "entity", @@ -208,12 +208,12 @@ curl http://localhost:8081/api/rest/schemaVersion | jq . ### Deleting collection entities ```console -curl -X DELETE http://localhost:8081/api/rest/collection/entity/9474f0eb-06d7-4fd8-b89e-0ce996962508.json | jq . +curl -X DELETE http://localhost:8081/api/rest/collection/entity/9474f0eb-06d7-4fd8-b89e-0ce996962508 | jq . ``` ```json { - "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json", + "$id": "9474f0eb-06d7-4fd8-b89e-0ce996962508", "description": "Description of entity 1", "name": "Entity 1" } diff --git a/docs/get-started-cli.md b/docs/get-started-cli.md index 22c0a0f..46ee2cb 100644 --- a/docs/get-started-cli.md +++ b/docs/get-started-cli.md @@ -25,7 +25,7 @@ Take note of the `$fileName` in the output. Note that it should be different for ```json { - "$fileName": "9474f0eb-06d7-4fd8-b89e-0ce996962508.json", + "$id": "9474f0eb-06d7-4fd8-b89e-0ce996962508", "description": "Welcome to Biscotte restaurant! Restaurant Biscotte offers a cuisine based on fresh, quality products, often local, organic when possible, and always produced by passionate producers.", "name": "Biscotte Restaurant" } @@ -37,7 +37,7 @@ Take note of the `$fileName` in the output. Note that it should be different for acms collection add category <<'EOF' { "name": "French Food", - "restaurant": { "$ref": "restaurant/9474f0eb-06d7-4fd8-b89e-0ce996962508.json" } + "restaurant": { "$ref": "restaurant/9474f0eb-06d7-4fd8-b89e-0ce996962508" } } EOF ``` @@ -46,7 +46,7 @@ EOF acms collection add category <<'EOF' { "name": "Brunch", - "restaurant": { "$ref": "restaurant/9474f0eb-06d7-4fd8-b89e-0ce996962508.json" } + "restaurant": { "$ref": "restaurant/9474f0eb-06d7-4fd8-b89e-0ce996962508" } } EOF ``` @@ -68,7 +68,7 @@ curl 'http://localhost:8081/api/query' --data ' LEFT JOIN category ON - category.restaurant == restaurant.$fileName + category.restaurant == restaurant.$id ' | jq . ``` diff --git a/frontend/app/Schema.hs b/frontend/app/Schema.hs index cae9ed6..5f4ddae 100644 --- a/frontend/app/Schema.hs +++ b/frontend/app/Schema.hs @@ -108,7 +108,7 @@ schemaTable collection schema paginated = [] [ td_ [] $ [ case (k, p, getO (AK.fromText (fromMisoString k)) value) of - ("$fileName", _, A.String fn) -> + ("$id", _, A.String fn) -> a_ [ href_ (routeToMisoString (EditValue collection (toMisoString fn))) |