use backend REST library for frontend

17 files changed, 331 insertions, 232 deletions

diff --git a/backend/app/Main.hs b/backend/app/Main.hs
index a81d769..445b3d1 100644
--- a/backend/app/Main.hs
+++ b/backend/app/Main.hs
@@ -1,6 +1,8 @@
+{-# LANGUAGE ApplicativeDo #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NondecreasingIndentation #-}
 {-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ApplicativeDo #-}
+
 module Main where
 
 import AutoTypes qualified as U
@@ -11,13 +13,19 @@ import Control.Concurrent.STM
 import Control.Monad
 import Control.Monad.Trans (liftIO)
 import Data.Aeson qualified as J
+import Data.Aeson.KeyMap qualified as JM
 import Data.Attoparsec.Char8 as P
+import Data.ByteString.Char8 qualified as B
 import Data.ByteString.Lazy.UTF8 qualified as LB
+import Data.ByteString.UTF8 qualified as B
 import Data.Map qualified as M
 import Data.Map.Merge.Strict qualified as M
 import Data.Maybe
 import Data.String (IsString (fromString))
 import Data.Tagged (Tagged (..))
+import Data.Text qualified as T
+import Data.UUID qualified as U
+import Data.UUID.V4 qualified as U
 import Debug.Trace
 import Git qualified as G
 import Git.Libgit2 qualified as GB
@@ -29,11 +37,12 @@ import Options.Applicative qualified as A
 import Route qualified as R
 import Safe
 import Store qualified as Q
-import System.Directory (setCurrentDirectory, doesDirectoryExist, makeAbsolute)
+import System.Directory (doesDirectoryExist, makeAbsolute, setCurrentDirectory)
 import System.Exit
 import System.FilePath
 import System.INotify
 import System.IO qualified as IO
+import Text.Printf (printf)
 import Version
 
 data Args = Args
@@ -44,8 +53,8 @@ args :: A.Parser Args
 args = Args <$> cmd'
 
 data Cmd = Serve
-  { serverPort :: Int
-  , contentRepositoryPath :: FilePath
+  { serverPort :: Int,
+    contentRepositoryPath :: FilePath
   }
 
 cmd' :: A.Parser Cmd
@@ -222,36 +231,66 @@ main = do
 
       logStderr ("Serving " ++ contentRepositoryPath' ++ " on port " ++ show serverPort ++ ".")
 
-      W.runEnv serverPort $ \req respond -> do
-        case P.parseOnly R.parser (W.rawPathInfo req) of
-          Right (R.SchemaJson path) -> do
-            repo <- atomically (readTMVar repoT)
-            let [c] = filter ((== path) . (.path)) (last repo.commits).collections
-            respond . W.responseLBS W.status200 [] $
-              J.encode (fromAutoTypes path c.schema)
-          Right R.Query -> do
-            q <-
-              fromString @Q.Query . LB.toString
-                <$> W.lazyRequestBody req
-            r <- liftIO $ Q.withStore root ref do Q.query q
-            respond . W.responseLBS W.status200 [] $ J.encode r
-          Right R.SchemaVersion -> do
-            repo <- atomically (readTMVar repoT)
-            respond $
-              W.responseLBS W.status200 [] $
-                J.encode (last repo.commits).schemaVersion
-          Right R.Collections -> do
-            if
-              | W.requestMethod req == "POST" -> do
-                  Right collection <- J.eitherDecode <$> W.lazyRequestBody req
-                  Q.withStore root ref do
-                    Q.writeFile (collection </> ".gitkeep") ""
-                    Q.commit
-                  respond $ W.responseLBS W.status200 [] "{}"
-              | W.requestMethod req == "GET" -> do
-                  repo <- atomically (readTMVar repoT)
-                  respond $
-                    W.responseLBS W.status200 [] $
-                      J.encode (map (.path) (last repo.commits).collections)
-          (traceShowId -> !_) ->
-            respond $ W.responseLBS W.status200 [] "not implemented"
+      W.runEnv serverPort . restApi root ref repoT $
+        ( \req respond -> do
+            case P.parseOnly R.parser (W.rawPathInfo req) of
+              Right R.Query -> do
+                q <-
+                  fromString @Q.Query . LB.toString
+                    <$> W.lazyRequestBody req
+                r <- liftIO $ Q.withStore root ref do Q.query q
+                respond . W.responseLBS W.status200 [] $ J.encode r
+              (traceShowId -> !_) ->
+                respond $ W.responseLBS W.status200 [] "not implemented"
+        )
+
+restApi :: String -> T.Text -> TMVar Repo -> W.Middleware
+restApi root ref repoT app req respond =
+  case traceShowId (drop 1 (B.split '/' (W.rawPathInfo req))) of
+    ("api" : "rest" : rs) ->
+      case (W.requestMethod req, rs) of
+        ("GET", ["schemaVersion"]) -> do
+          repo <- atomically (readTMVar repoT)
+          respond $
+            W.responseLBS W.status200 [] $
+              J.encode (last repo.commits).schemaVersion
+        ("GET", ["collection"]) -> do
+          repo <- atomically (readTMVar repoT)
+          respond $
+            W.responseLBS W.status200 [] $
+              J.encode (map (.path) (last repo.commits).collections)
+        ("POST", ["collection"]) -> do
+          Right collection <- J.eitherDecode <$> W.lazyRequestBody req
+          Q.withStore root ref do
+            Q.writeFile (collection </> ".gitkeep") ""
+            Q.commit
+          respond $ W.responseLBS W.status200 [] "{}"
+        ("GET", ["collection", B.toString -> c]) -> do
+          respond . W.responseLBS W.status200 [] . J.encode
+            =<< Q.withStore root ref do
+              Q.query (fromString (printf "SELECT %s FROM %s" c c))
+        ("GET", ["collection", B.toString -> c, B.toString -> i]) -> do
+          respond . W.responseLBS W.status200 [] . J.encode
+            =<< Q.withStore root ref do
+              Q.query (fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i))
+        ("PUT", ["collection", B.toString -> c, B.toString -> i]) -> do
+          o <- J.throwDecode @J.Object =<< W.lazyRequestBody req
+          respond . W.responseLBS W.status200 [] . J.encode
+            =<< 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))
+        ("POST", ["collection", B.toString -> c]) -> do
+          i <- ((<> ".json") . U.toText) <$> U.nextRandom
+          o <- J.throwDecode @J.Object =<< W.lazyRequestBody req
+          respond . W.responseLBS W.status200 [] . J.encode
+            =<< 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))
+        ("DELETE", ["collection", B.toString -> c, B.toString -> i]) -> do
+          respond . W.responseLBS W.status200 [] . J.encode
+            =<< Q.withStore root ref do
+              Q.query (fromString (printf "DELETE FROM %s WHERE %s.$fileName == \"%s\"" c c i))
+        ("GET", ["collection", B.toString -> c, "schema"]) -> do
+          repo <- atomically (readTMVar repoT)
+          let [collection] = filter ((== c) . (.path)) (last repo.commits).collections
+          respond . W.responseLBS W.status200 [] $
+            J.encode (fromAutoTypes c collection.schema)
+    _ -> app req respond
diff --git a/backend/app/Route.hs b/backend/app/Route.hs
index 61fa699..59c5342 100644
--- a/backend/app/Route.hs
+++ b/backend/app/Route.hs
@@ -3,19 +3,11 @@ module Route (Route (..), parser) where
 import Data.Attoparsec.Char8 qualified as P
 
 data Route
-  = SchemaJson String
-  | Query
-  | SchemaVersion
-  | Collections
+  = Query
   deriving (Show)
 
 parser :: P.Parser Route
 parser =
-  ( P.choice
-      [ pure Collections <* P.string "/collections",
-        pure SchemaVersion <* P.string "/schemaVersion",
-        SchemaJson <$> (P.string "/" *> P.manyTill P.anyChar (P.string ".schema.json")),
-        pure Query <* P.string "/"
-      ]
-  )
+  pure Query
+    <* P.string "/"
     <* P.endOfInput
diff --git a/backend/backend.cabal b/backend/backend.cabal
index f92dd46..b2ca82b 100644
--- a/backend/backend.cabal
+++ b/backend/backend.cabal
@@ -8,42 +8,31 @@ author:        Alexander Foremny
 build-type:    Simple
 
 library
-    exposed-modules:    ACMS.API.REST.Collection
+    exposed-modules:
+        ACMS.API.REST
+        ACMS.API.REST.Collection
+
     hs-source-dirs:     lib
     default-language:   GHC2021
     default-extensions:
-        BlockArguments LambdaCase OverloadedStrings ViewPatterns
+        CPP BlockArguments LambdaCase OverloadedStrings ViewPatterns
         OverloadedRecordDot NoFieldSelectors MultiWayIf
 
     ghc-options:        -Wall -threaded
     build-depends:
         aeson,
-        astore,
-        attoparsec,
-        autotypes,
         base,
         bytestring,
-        common,
-        containers,
-        directory,
-        filepath,
-        gitlib,
-        gitlib-libgit2,
-        hinotify,
-        hlibgit2,
-        http-conduit,
-        http-types,
-        mtl,
-        optparse-applicative,
-        safe,
-        split,
-        stm,
-        tagged,
+        exceptions,
+        miso,
         text,
-        utf8-string,
-        uuid,
-        wai,
-        warp
+        utf8-string
+
+    if arch(javascript)
+        build-depends: ghcjs-base
+
+    else
+        build-depends: http-conduit
 
 executable backend
     main-is:            Main.hs
@@ -79,5 +68,9 @@ executable backend
         tagged,
         text,
         utf8-string,
+        uuid,
         wai,
         warp
+
+    if arch(javascript)
+        buildable: False
diff --git a/backend/lib/ACMS/API/REST.hs b/backend/lib/ACMS/API/REST.hs
new file mode 100644
index 0000000..6aca780
--- /dev/null
+++ b/backend/lib/ACMS/API/REST.hs
@@ -0,0 +1,75 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module ACMS.API.REST where
+
+#ifndef ghcjs_HOST_OS
+import Network.HTTP.Simple
+#else
+import Data.ByteString.Char8 qualified as B
+import Data.Maybe
+import Data.String
+import JavaScript.Web.XMLHttpRequest
+import Miso.String qualified as J
+#endif
+import Control.Monad.Catch (MonadThrow)
+import Data.Aeson qualified as A
+import Data.ByteString.Lazy.Char8 qualified as LB
+import Data.ByteString.Lazy.UTF8 qualified as LB
+import Data.Function ((&))
+import Miso (JSM)
+import Miso.String (MisoString)
+
+schemaVersion :: (APIMonad m, A.FromJSON a) => m a
+schemaVersion =
+  "http://localhost:8081/api/rest/schemaVersion"
+    & fetch
+    >>= A.throwDecode
+
+listCollections :: (APIMonad m) => m [MisoString]
+listCollections =
+  "http://localhost:8081/api/rest/collection"
+    & fetch
+    >>= A.throwDecode
+
+createCollection :: (APIMonad m) => MisoString -> m ()
+createCollection collection =
+  "http://localhost:8081/api/rest/collections"
+    & setRequestMethod "POST"
+    & setRequestBodyLBS (A.encode (A.toJSON collection))
+    & fetch
+    >>= A.throwDecode
+
+class (MonadThrow m) => APIMonad m where
+  fetch :: Request -> m LB.ByteString
+
+instance APIMonad JSM where
+  fetch req = LB.fromStrict . getResponseBody <$> httpBS req
+
+#ifdef ghcjs_HOST_OS
+
+httpBS :: Request -> JSM (Response B.ByteString)
+httpBS req = xhrByteString req
+
+instance IsString Request where
+  fromString uri =
+    Request
+      { reqMethod = GET,
+        reqURI = J.pack uri,
+        reqLogin = Nothing,
+        reqHeaders = [],
+        reqWithCredentials = False,
+        reqData = NoData
+      }
+
+setRequestMethod :: B.ByteString -> Request -> Request
+setRequestMethod "POST" req = req {reqMethod = POST}
+
+setRequestBodyLBS :: LB.ByteString -> Request -> Request
+setRequestBodyLBS body req = req {reqData = StringData (J.pack (LB.toString body))}
+
+getResponseBody :: Response B.ByteString -> B.ByteString
+getResponseBody = fromMaybe "" . contents
+#else
+instance APIMonad IO where
+  fetch req = LB.fromStrict . getResponseBody <$> httpBS req
+#endif
diff --git a/backend/lib/ACMS/API/REST/Collection.hs b/backend/lib/ACMS/API/REST/Collection.hs
index c22b6ba..e0df21b 100644
--- a/backend/lib/ACMS/API/REST/Collection.hs
+++ b/backend/lib/ACMS/API/REST/Collection.hs
@@ -2,68 +2,59 @@
 
 module ACMS.API.REST.Collection where
 
+#ifndef ghcjs_HOST_OS
+import Network.HTTP.Simple
+#else
+import ACMS.API.REST (setRequestMethod, setRequestBodyLBS, getResponseBody)
+import Data.ByteString.Char8 qualified as B
+import Data.Maybe
+import JavaScript.Web.XMLHttpRequest
+import Miso.String qualified as J
+#endif
+import ACMS.API.REST (APIMonad, fetch)
 import Data.Aeson qualified as A
-import Data.Aeson.KeyMap qualified as AM
-import Data.ByteString.Lazy.UTF8 qualified as LB
 import Data.Function ((&))
 import Data.String (fromString)
-import Data.Text qualified as T
-import Network.HTTP.Simple
+import Miso.String (MisoString)
 import Text.Printf (printf)
-import Data.UUID qualified as U
-import Data.UUID.V4 qualified as U
 
-type CollectionName = T.Text
-
-list :: T.Text -> IO [A.Object]
+list :: (APIMonad m) => MisoString -> m [A.Object]
 list c =
-  "http://localhost:8081"
-    & setRequestMethod "POST"
-    & setRequestBodyLBS (LB.fromString (printf "SELECT %s FROM %s" c c))
-    & httpLBS
-    >>= A.throwDecode . getResponseBody
+  fromString (printf "http://localhost:8081/api/rest/collection/%s" c)
+    & fetch
+    >>= A.throwDecode
 
-read :: T.Text -> T.Text -> IO [A.Object]
+read :: (APIMonad m) => MisoString -> MisoString -> m [A.Object]
 read c i =
-  "http://localhost:8081"
-    & setRequestMethod "POST"
-    & setRequestBodyLBS
-      (LB.fromString (printf "SELECT %s FROM %s WHERE %s.$fileName == \"%s\"" c c c i))
-    & httpLBS
-    >>= A.throwDecode . getResponseBody
+  fromString (printf "http://localhost:8081/api/rest/collection/%s/%s" c i)
+    & fetch
+    >>= A.throwDecode
 
-update :: T.Text -> T.Text -> A.Object -> IO ()
+update :: (APIMonad m) => MisoString -> MisoString -> A.Object -> m ()
 update c i o =
-  "http://localhost:8081"
-    & setRequestMethod "POST"
-    & setRequestBodyLBS
-      (LB.fromString (printf "UPDATE %s SET %s WHERE %s.$fileName == \"%s\"" c (LB.toString (A.encode o)) c i))
-    & httpLBS
-    >>= A.throwDecode . getResponseBody
+  fromString (printf "http://localhost:8081/api/rest/collection/%s/%s" c i)
+    & setRequestMethod "PUT"
+    & setRequestBodyLBS (A.encode o)
+    & fetch
+    >>= A.throwDecode
 
-create :: T.Text -> A.Object -> IO U.UUID
+create :: (APIMonad m) => MisoString -> A.Object -> m A.Object
 create c o = do
-  uuid <- U.nextRandom
-  let i = U.toText uuid <> ".json"
-  response <- "http://localhost:8081"
+  fromString (printf "http://localhost:8081/api/rest/collection/%s" c)
     & setRequestMethod "POST"
-    & setRequestBodyLBS
-      (LB.fromString (printf "INSERT %s INTO %s" (LB.toString (A.encode (AM.insert "$fileName" (A.String i) o))) c))
-    & httpLBS
-  uuid <$ A.throwDecode @() (getResponseBody response)
+    & setRequestBodyLBS (A.encode o)
+    & fetch
+    >>= A.throwDecode
 
-delete :: T.Text -> T.Text -> IO [A.Object]
+delete :: (APIMonad m) => MisoString -> MisoString -> m [A.Object]
 delete c i =
-  "http://localhost:8081"
-    & setRequestMethod "POST"
-    & setRequestBodyLBS
-      (LB.fromString (printf "DELETE FROM %s WHERE %s.$fileName == \"%s\"" c c i))
-    & httpLBS
-    >>= A.throwDecode . getResponseBody
+  fromString (printf "http://localhost:8081/api/rest/collection/%s/%s" c i)
+    & setRequestMethod "DELETE"
+    & fetch
+    >>= A.throwDecode
 
-schema :: T.Text -> IO A.Value
+schema :: (APIMonad m) => (A.FromJSON a) => MisoString -> m a
 schema c =
-  fromString (printf "http://localhost:8081/%s.schema.json" c)
-    & setRequestMethod "POST"
-    & httpLBS
-    >>= A.throwDecode . getResponseBody
+  fromString (printf "http://localhost:8081/api/rest/collection/%s/schema" c)
+    & fetch
+    >>= A.throwDecode
diff --git a/cli/app/Main.hs b/cli/app/Main.hs
index e8d9605..3584d72 100644
--- a/cli/app/Main.hs
+++ b/cli/app/Main.hs
@@ -112,5 +112,5 @@ main =
             =<< J.throwDecode
             =<< LB.getContents
         CollectionSchema (Collection cn) ->
-          LB.putStr . J.encodePretty
+          LB.putStr . J.encodePretty @J.Value
             =<< ACMS.API.REST.Collection.schema cn
diff --git a/default.nix b/default.nix
index 382b715..eacf111 100644
--- a/default.nix
+++ b/default.nix
@@ -17,6 +17,7 @@ let
 
   jsHaskellPackages = pkgs.pkgsCross.ghcjs.haskell.packages.ghc98.override {
     overrides = self: super: {
+      backend = self.callCabal2nix "backend" ./backend { };
       common = self.callCabal2nix "common" ./common { };
       frontend = self.callCabal2nix "frontend" ./frontend { };
     };
@@ -29,6 +30,7 @@ rec {
     packages = _: [
       haskellPackages.autotypes
       haskellPackages.backend
+      haskellPackages.cli
       haskellPackages.common
       haskellPackages.cli
       haskellPackages.frontend
diff --git a/frontend/app/Form/Input.hs b/frontend/app/Form/Input.hs
index e43651c..99fd821 100644
--- a/frontend/app/Form/Input.hs
+++ b/frontend/app/Form/Input.hs
@@ -3,30 +3,29 @@ module Form.Input
   )
 where
 
-import Data.Text qualified as T
 import Form.Internal
 import Miso
-import Miso.String (fromMisoString, toMisoString)
+import Miso.String (MisoString, null, strip)
 
-input :: String -> Form T.Text T.Text
+input :: MisoString -> Form MisoString MisoString
 input label =
-  let parse :: T.Text -> Either String T.Text
+  let parse :: MisoString -> Either MisoString MisoString
       parse i =
-        let i' = T.strip i
-         in if T.null i' then Left "required" else Right i'
+        let i' = strip i
+         in if Miso.String.null i' then Left "required" else Right i'
    in Form
         { view = \i ->
             [ div_ [] $
                 [ label_ [] $
-                    [ text (toMisoString label),
+                    [ text label,
                       div_ [] $
                         [ input_
                             [ type_ "text",
-                              value_ (toMisoString i),
-                              onInput fromMisoString
+                              value_ i,
+                              onInput id
                             ],
                           div_ [] $
-                            [either (text . toMisoString) (\_ -> text "") (parse i)]
+                            [either text (\_ -> text "") (parse i)]
                         ]
                     ]
                 ]
diff --git a/frontend/app/Form/Internal.hs b/frontend/app/Form/Internal.hs
index 2274c63..35d59e7 100644
--- a/frontend/app/Form/Internal.hs
+++ b/frontend/app/Form/Internal.hs
@@ -6,12 +6,12 @@ module Form.Internal
   )
 where
 
-import Data.Text qualified as T
 import Miso
+import Miso.String (MisoString, null, strip)
 
 data Form i o = Form
   { view :: i -> [View i],
-    fill :: i -> Either String o
+    fill :: i -> Either MisoString o
   }
 
 instance Functor (Form i) where
@@ -63,8 +63,8 @@ runForm form i =
 class IsEmpty i where
   isEmpty :: i -> Bool
 
-instance IsEmpty T.Text where
-  isEmpty = T.null . T.strip
+instance IsEmpty MisoString where
+  isEmpty = Miso.String.null . strip
 
 optional :: (IsEmpty i) => Form i o -> Form i (Maybe o)
 optional form =
diff --git a/frontend/app/Main.hs b/frontend/app/Main.hs
index f3d40c8..9f30708 100644
--- a/frontend/app/Main.hs
+++ b/frontend/app/Main.hs
@@ -1,10 +1,13 @@
+{-# LANGUAGE ViewPatterns #-}
+
 module Main where
 
 #ifndef ghcjs_HOST_OS
 import Language.Javascript.JSaddle.Warp as JSaddle
 #endif
 
-import Api
+import ACMS.API.REST as API.REST
+import Control.Monad.Catch
 import Control.Monad.Trans
 import Data.Bifunctor
 import Data.Default
@@ -12,7 +15,7 @@ import Data.Function
 import Effect (Eff)
 import Effect qualified as E
 import Miso
-import Miso.String (toMisoString)
+import Miso.String (MisoString, toMisoString)
 import NeatInterpolation qualified as Q
 import Page (Page, initialPage, updatePage, viewPage)
 import Page qualified as Page
@@ -21,14 +24,14 @@ import Version
 
 data Model
   = Loading
-  | Failed String
+  | Failed MisoString
   | Loaded LoadedState
   deriving (Show, Eq)
 
 data LoadedState = LoadedState
-  { collections :: [String],
+  { collections :: [MisoString],
     schemaVersion :: Version,
-    page :: Maybe (Either String Page)
+    page :: Maybe (Either MisoString Page)
   }
   deriving (Show, Eq)
 
@@ -37,11 +40,6 @@ instance Default Model where
 
 newtype Action = Action (Model -> Effect Action Model)
 
--- TODO
-instance Show Action
-
-instance Eq Action
-
 #ifndef ghcjs_HOST_OS
 runApp :: JSM () -> IO ()
 runApp f = JSaddle.debugOr 8080 (f >> syncPoint) JSaddle.jsaddleApp
@@ -67,18 +65,20 @@ update__init :: URI -> Action
 update__init uri = Action $ \case
   Loading ->
     Loading <# do
-      page <- Just <$> initialPage (parseURI uri)
-      schemaVersion' <- fetchSchemaVersion
-      collections' <- fetchCollections
+      page <-
+        Just . first (toMisoString . displayException)
+          <$> initialPage (parseURI uri)
+      schemaVersion' <- try API.REST.schemaVersion
+      collections' <- try API.REST.listCollections
       pure $ update__setLoaded do
         schemaVersion <- schemaVersion'
         collections <- collections'
         pure LoadedState {..}
   m -> noEff m
 
-update__setLoaded :: Either String LoadedState -> Action
+update__setLoaded :: Either SomeException LoadedState -> Action
 update__setLoaded (Left e) = Action $ \case
-  Loading -> noEff (Failed e)
+  Loading -> noEff (Failed (toMisoString (displayException e)))
   m -> noEff m
 update__setLoaded (Right s) = Action $ \case
   Loading -> noEff (Loaded s)
@@ -95,10 +95,11 @@ update__handleURI uri = Action $ \case
       update__setPage <$> initialPage route
   m -> noEff m
 
-update__setPage :: Either String Page -> Action
-update__setPage (Just -> page) = Action $ \case
-  Loaded s -> noEff (Loaded s {page})
-  m -> noEff m
+update__setPage :: Either SomeException Page -> Action
+update__setPage
+  ((Just . first (toMisoString . displayException)) -> page) = Action $ \case
+    Loaded s -> noEff (Loaded s {page = page})
+    m -> noEff m
 
 update__handlePage :: Page.Action -> Action
 update__handlePage action = Action $ \case
@@ -121,18 +122,18 @@ update__handleEff eff = Action $ \case
   Loaded s -> Loaded s <# handleEff eff
   m -> noEff m
 
-update__setCollections :: Either String [String] -> Action
+update__setCollections :: Either SomeException [MisoString] -> Action
 update__setCollections (Left err) = Action $ \case
   Loaded s ->
     Loaded s <# do
-      pure update__noOp <* consoleLog (toMisoString err)
+      pure update__noOp <* consoleLog (toMisoString (displayException err))
   m -> noEff m
 update__setCollections (Right collections) = Action $ \case
   Loaded s -> noEff (Loaded s {collections})
   m -> noEff m
 
 handleEff :: Eff -> JSM Action
-handleEff E.ReloadCollections = update__setCollections <$> fetchCollections
+handleEff E.ReloadCollections = update__setCollections <$> try API.REST.listCollections
 
 viewModel :: Model -> View Action
 viewModel Loading = text ".."
@@ -234,8 +235,8 @@ th, td {
         )
     ]
 
-err :: String -> View action
-err = text . toMisoString . ("err! " <>)
+err :: MisoString -> View action
+err = text . ("err! " <>)
 
 viewHeader :: LoadedState -> View Action
 viewHeader s =
diff --git a/frontend/app/Page.hs b/frontend/app/Page.hs
index 3218ae6..c7b393f 100644
--- a/frontend/app/Page.hs
+++ b/frontend/app/Page.hs
@@ -7,6 +7,7 @@ module Page
   )
 where
 
+import Control.Monad.Catch (SomeException)
 import Data.Bifunctor
 import Data.Default
 import Data.Function
@@ -30,7 +31,7 @@ newtype Action = Action (Page -> (Effect Action Page, [Eff]))
 instance Default Page where
   def = Home
 
-initialPage :: Route -> JSM (Either String Page)
+initialPage :: Route -> JSM (Either SomeException Page)
 initialPage Route.Home = pure (Right Home)
 initialPage (Route.ListCollection c) =
   fmap ListCollection <$> ListCollection.initialModel c
diff --git a/frontend/app/Page/EditValue.hs b/frontend/app/Page/EditValue.hs
index cdb1dd0..cf8ef50 100644
--- a/frontend/app/Page/EditValue.hs
+++ b/frontend/app/Page/EditValue.hs
@@ -7,7 +7,8 @@ module Page.EditValue
   )
 where
 
-import Api
+import ACMS.API.REST.Collection qualified as API.REST.Collection
+import Control.Monad.Catch (SomeException, try)
 import Data.Aeson qualified as A
 import Data.Aeson.KeyMap qualified as AM
 import Data.ByteString.Lazy.UTF8 as LB
@@ -15,21 +16,22 @@ import Data.Maybe
 import Effect (Eff)
 import Form qualified as F
 import Miso
-import Miso.String (toMisoString)
+import Miso.String (MisoString, toMisoString)
+import Safe (headMay)
 import Schema
 
 data Model = Model
-  { collection :: String,
-    fileName :: String,
-    input :: Maybe A.Value,
+  { collection :: MisoString,
+    fileName :: MisoString,
+    input :: Maybe A.Object,
     schema :: Schema
   }
   deriving (Show, Eq)
 
-initialModel :: String -> String -> JSM (Either String Model)
+initialModel :: MisoString -> MisoString -> JSM (Either SomeException Model)
 initialModel collection fileName = do
-  schema' <- fetchSchema
-  input' <- fetchPost fileName
+  schema' <- try (API.REST.Collection.schema collection)
+  input' <- try (headMay <$> API.REST.Collection.read collection fileName)
   pure do
     schema <- schema'
     input <- input'
@@ -37,14 +39,14 @@ initialModel collection fileName = do
 
 newtype Action = Action (Model -> (Effect Action Model, [Eff]))
 
-update__formChanged :: A.Value -> Action
+update__formChanged :: A.Object -> Action
 update__formChanged (Just -> input) = Action $ \m -> (noEff m {input}, [])
 
-update__formSubmitted :: A.Value -> Action
+update__formSubmitted :: A.Object -> Action
 update__formSubmitted output = Action $ \m ->
-  (m <# do update__entityWritten <$> updatePost m.fileName output, [])
+  (m <# do update__entityWritten <$> try (API.REST.Collection.update m.collection m.fileName output), [])
 
-update__entityWritten :: Either String () -> Action
+update__entityWritten :: Either SomeException () -> Action
 update__entityWritten _ = Action $ \m -> (noEff m, [])
 
 updateModel :: Action -> Model -> (Effect Action Model, [Eff])
@@ -52,29 +54,27 @@ updateModel (Action f) m = f m
 
 viewModel :: Model -> View Action
 viewModel m = do
-  let input = (fromMaybe (A.Object AM.empty) m.input)
+  let input = (fromMaybe AM.empty m.input)
   div_ [] $
     [ viewForm input m.schema,
       viewInput input,
       viewOutput input m.schema
     ]
 
-viewForm :: A.Value -> Schema -> View Action
+viewForm :: A.Object -> Schema -> View Action
 viewForm input =
   fmap (either update__formChanged update__formSubmitted)
     . flip F.runForm input
     . schemaForm
 
-viewInput :: A.Value -> View Action
+viewInput :: A.Object -> View Action
 viewInput input =
   pre_ [] [text (toMisoString (A.encode input))]
 
-viewOutput :: A.Value -> Schema -> View Action
+viewOutput :: A.Object -> Schema -> View Action
 viewOutput input schema =
   pre_ [] $
     [ text $
-        toMisoString
-          ( either ("Left " <>) (("Right " <>) . LB.toString) $
-              (A.encode <$> ((schemaForm schema).fill input))
-          )
+        either ("Left " <>) (("Right " <>)) $
+          (toMisoString . A.encode <$> ((schemaForm schema).fill input))
     ]
diff --git a/frontend/app/Page/ListCollection.hs b/frontend/app/Page/ListCollection.hs
index 9acca3c..47a4649 100644
--- a/frontend/app/Page/ListCollection.hs
+++ b/frontend/app/Page/ListCollection.hs
@@ -7,29 +7,31 @@ module Page.ListCollection
   )
 where
 
-import Api
+import ACMS.API.REST.Collection qualified as API.REST.Collection
+import Control.Monad.Catch (SomeException, try)
 import Data.Aeson qualified as A
 import Data.Aeson.KeyMap qualified as AM
 import Effect (Eff)
 import Miso
+import Miso.String (MisoString)
 import Schema
 
 data Model = Model
-  { collection :: String,
-    input :: A.Value,
+  { collection :: MisoString,
+    input :: A.Object,
     schema :: Schema,
-    posts :: [A.Value]
+    posts :: [A.Object]
   }
   deriving (Show, Eq)
 
-initialModel :: String -> JSM (Either String Model)
+initialModel :: MisoString -> JSM (Either SomeException Model)
 initialModel collection = do
-  schema' <- fetchSchema
-  posts' <- fetchPosts
+  schema' <- try (API.REST.Collection.schema collection)
+  posts' <- try (API.REST.Collection.list collection)
   pure do
     schema <- schema'
     posts <- posts'
-    pure $ Model {input = A.Object AM.empty, ..}
+    pure $ Model {input = AM.empty, ..}
 
 newtype Action = Action (Model -> (Effect Action Model, [Eff]))
 
diff --git a/frontend/app/Page/NewCollection.hs b/frontend/app/Page/NewCollection.hs
index 12b9cf1..a15d4a7 100644
--- a/frontend/app/Page/NewCollection.hs
+++ b/frontend/app/Page/NewCollection.hs
@@ -7,37 +7,38 @@ module Page.NewCollection
   )
 where
 
-import Api
+import ACMS.API.REST qualified as API.REST
+import Control.Monad.Catch (SomeException, try)
 import Data.Aeson qualified as A
 import Data.Text qualified as T
 import Effect (Eff)
 import Effect qualified as E
 import Form qualified as F
 import Miso
-import Miso.String (toMisoString)
+import Miso.String (MisoString, toMisoString)
 
 data Model = Model
-  { input :: T.Text
+  { input :: MisoString
   }
   deriving (Show, Eq)
 
-initialModel :: JSM (Either String Model)
+initialModel :: JSM (Either SomeException Model)
 initialModel = do
   pure (Right (Model {input = ""}))
 
 newtype Action = Action (Model -> (Effect Action Model, [Eff]))
 
-update__formChanged :: T.Text -> Action
+update__formChanged :: MisoString -> Action
 update__formChanged input = Action $ \m -> (noEff m {input}, [])
 
-update__formSubmitted :: T.Text -> Action
+update__formSubmitted :: MisoString -> Action
 update__formSubmitted collection = Action $ \m ->
   ( m <# do
-      update__collectionCreated <$> createCollection (T.unpack collection),
+      update__collectionCreated <$> try (API.REST.createCollection collection),
     []
   )
 
-update__collectionCreated :: Either String () -> Action
+update__collectionCreated :: Either SomeException () -> Action
 update__collectionCreated _ = Action $ \m -> (noEff m, [E.ReloadCollections])
 
 updateModel :: Action -> Model -> (Effect Action Model, [Eff])
@@ -53,6 +54,6 @@ viewModel m = do
       pre_ [] [text (toMisoString (A.encode (collectionForm.fill m.input)))]
     ]
 
-collectionForm :: F.Form T.Text T.Text
+collectionForm :: F.Form MisoString MisoString
 collectionForm =
   F.input "name"
diff --git a/frontend/app/Route.hs b/frontend/app/Route.hs
index d683b76..e2d2838 100644
--- a/frontend/app/Route.hs
+++ b/frontend/app/Route.hs
@@ -1,7 +1,7 @@
 module Route
   ( Route (..),
     parseURI,
-    routeToString,
+    routeToMisoString,
   )
 where
 
@@ -9,11 +9,12 @@ import Data.Attoparsec.Text qualified as P
 import Data.Default
 import Data.Text qualified as T
 import Miso
+import Miso.String (MisoString, toMisoString)
 
 data Route
   = Home
-  | ListCollection String
-  | EditValue String String
+  | ListCollection MisoString
+  | EditValue MisoString MisoString
   | NewCollection
   deriving (Show, Eq)
 
@@ -26,18 +27,18 @@ parseURI uri =
     P.parseOnly
       ( P.choice
           [ EditValue
-              <$> (P.string "#collection/" *> P.manyTill P.anyChar (P.string "/"))
-              <*> (P.many1 P.anyChar),
-            pure NewCollection <* (P.string "#collection/new"),
-            ListCollection <$> (P.string "#collection/" *> P.many1 P.anyChar),
+              <$> (toMisoString <$> (P.string "#collection/" *> P.manyTill P.anyChar (P.string "/")))
+              <*> (toMisoString <$> (P.many1 P.anyChar)),
+            pure NewCollection <* (toMisoString <$> (P.string "#collection/new")),
+            ListCollection <$> (toMisoString <$> (P.string "#collection/" *> P.many1 P.anyChar)),
             pure Home
           ]
           <* P.endOfInput
       )
       (T.pack uri.uriFragment)
 
-routeToString :: Route -> String
-routeToString Home = "#"
-routeToString (ListCollection collection) = "#collection/" <> collection
-routeToString (EditValue collection fileName) = "#collection/" <> collection <> "/" <> fileName
-routeToString NewCollection = "#collection/new"
+routeToMisoString :: Route -> MisoString
+routeToMisoString Home = "#"
+routeToMisoString (ListCollection collection) = "#collection/" <> collection
+routeToMisoString (EditValue collection fileName) = "#collection/" <> collection <> "/" <> fileName
+routeToMisoString NewCollection = "#collection/new"
diff --git a/frontend/app/Schema.hs b/frontend/app/Schema.hs
index 1a52f52..bc504cc 100644
--- a/frontend/app/Schema.hs
+++ b/frontend/app/Schema.hs
@@ -18,7 +18,7 @@ import Data.Maybe
 import Data.Text qualified as T
 import Form qualified as F
 import Miso
-import Miso.String (toMisoString)
+import Miso.String (MisoString, fromMisoString, toMisoString)
 import Route
 
 data Schema = Schema
@@ -67,7 +67,7 @@ viewSchema schema =
         )
           <$> (M.toList properties)
 
-schemaTable :: String -> Schema -> [A.Value] -> View action
+schemaTable :: MisoString -> Schema -> [A.Object] -> View action
 schemaTable collection schema values =
   table_ [] [thead, tbody]
   where
@@ -90,7 +90,7 @@ schemaTable collection schema values =
                       ("$fileName", A.String fn) ->
                         a_
                           [ href_
-                              (toMisoString (routeToString (EditValue collection (T.unpack fn))))
+                              (routeToMisoString (EditValue collection (toMisoString fn)))
                           ]
                           [ text (toMisoString fn)
                           ]
@@ -105,7 +105,7 @@ schemaTable collection schema values =
             | value <- values
           ]
 
-schemaForm :: Schema -> F.Form A.Value A.Value
+schemaForm :: Schema -> F.Form A.Object A.Object
 schemaForm schema =
   fmap mergeJson . sequence $
     case schema.type_ of
@@ -113,36 +113,36 @@ schemaForm schema =
         ( \(AK.fromString -> k, v) ->
             case v of
               "string" ->
-                A.Object . AM.singleton k
+                AM.singleton k
                   <$> ( F.mapValues (getO k) (setO k) $
-                          fmap A.String . F.mapValues fromJson toJson $
-                            F.input (AK.toString k)
+                          fmap (A.String . fromMisoString) . F.mapValues fromJson toJson $
+                            F.input (toMisoString (AK.toString k))
                       )
               "string?" ->
-                A.Object . AM.singleton k
+                AM.singleton k
                   <$> ( F.mapValues (getO k) (setO k)
-                          $ fmap (maybe A.Null A.String)
+                          $ fmap (maybe A.Null (A.String . fromMisoString))
                             . F.mapValues fromJson toJson
-                          $ F.optional (F.input (AK.toString k))
+                          $ F.optional (F.input (toMisoString (AK.toString k)))
                       )
         )
           <$> (M.toList properties)
 
-mergeJson :: [A.Value] -> A.Value
-mergeJson = foldl' mergeObject (A.Object AM.empty)
+mergeJson :: [A.Object] -> A.Object
+mergeJson = foldl' mergeObject AM.empty
 
-mergeObject :: A.Value -> A.Value -> A.Value
-mergeObject (A.Object kvs) (A.Object kvs') = A.Object (AM.union kvs kvs')
+mergeObject :: A.Object -> A.Object -> A.Object
+mergeObject kvs kvs' = AM.union kvs kvs'
 
-fromJson :: A.Value -> T.Text
-fromJson (A.String x) = x
+fromJson :: A.Value -> MisoString
+fromJson (A.String x) = toMisoString x
 fromJson _ = ""
 
-toJson :: T.Text -> A.Value -> A.Value
-toJson x _ = A.String x
+toJson :: MisoString -> A.Value -> A.Value
+toJson x _ = A.String (fromMisoString x)
 
-getO :: AK.Key -> A.Value -> A.Value
-getO k (A.Object kvs) = fromMaybe A.Null (AM.lookup k kvs)
+getO :: AK.Key -> A.Object -> A.Value
+getO k kvs = fromMaybe A.Null (AM.lookup k kvs)
 
-setO :: AK.Key -> A.Value -> A.Value -> A.Value
-setO k v (A.Object kvs) = A.Object (AM.insert k v kvs)
+setO :: AK.Key -> A.Value -> A.Object -> A.Object
+setO k v kvs = AM.insert k v kvs
diff --git a/frontend/frontend.cabal b/frontend/frontend.cabal
index 368049b..65b38f5 100644
--- a/frontend/frontend.cabal
+++ b/frontend/frontend.cabal
@@ -37,11 +37,13 @@ executable frontend
     build-depends:
         aeson,
         attoparsec,
+        backend,
         base,
         bytestring,
         common,
         containers,
         data-default,
+        exceptions,
         miso,
         mtl,
         neat-interpolation,