Modify metadata

src/API/Books.hs

@@ -64,7 +64,10 @@ postBookMetaHandler auth PostBook{..} = flip requireLoggedIn auth $ \SafeUser{us
 
 
 putBookMetaHandler :: AuthResult SafeUser -> BookID -> JsonBook -> AppM JsonBook
-putBookMetaHandler _ _ _ = throwM err403
+putBookMetaHandler auth bookId b@JsonBook{..}
+  | bookId == identifier = flip requireLoggedIn auth $ \SafeUser{username=owner} ->
+        maybe (throwM err403) (const (return b)) =<< runDB (updateBook UpdateBook{..})
+  | otherwise = throwM err403
 
 listBooksHandler :: AuthResult SafeUser -> AppM [JsonBook]
 listBooksHandler = requireLoggedIn $ \user -> do

src/Database/Book.hs

@@ -1,9 +1,12 @@
 {-# Language TypeApplications #-}
 {-# Language DataKinds #-}
+{-# Language DuplicateRecordFields #-}
 module Database.Book
   ( def
   , insertBook
+  , updateBook
   , InsertBook(..)
+  , UpdateBook(..)
   , usersBooks
   , Book(..)
   , BookID) where
@@ -39,3 +42,27 @@ insertBook InsertBook{..} = do
   forM (listToMaybe mUserId) $ \userId -> do
     let book = Book{owner=userId,identifier=def,contentHash=Nothing,..}
     BookID . fromRowId <$> insertGenWithPK books [book]
+
+data UpdateBook = UpdateBook { identifier :: BookID
+                             , contentType :: Text
+                             , title :: Maybe Text
+                             , description :: Maybe Text
+                             , owner :: Username }
+
+updateBook :: (MonadSelda m, MonadMask m, MonadIO m) => UpdateBook -> m (Maybe UpdateBook)
+updateBook book@UpdateBook{..} = do
+  mUserId <- query $ do
+    userId :*: _ :*: username :*: _ <- select (gen users)
+    bookId :*: _ :*: _ :*: _ :*: _ :*: bookOwner <- select (gen books)
+    restrict (userId .== bookOwner)
+    restrict (username .== literal owner)
+    restrict (bookId .== literal identifier)
+    return userId
+  forM (listToMaybe mUserId) $ \_userId -> do
+    update_ (gen books) predicate (\b -> b `with` [ pContentType := literal contentType
+                                                  , pTitle := literal title
+                                                  , pDescription := literal description ])
+    return book
+  where
+    _ :*: _ :*: pContentType :*: pTitle :*: pDescription :*: _ = selectors (gen books)
+    predicate (bookId :*: _) = bookId .== literal identifier

src/Database/Schema.hs

@@ -42,7 +42,7 @@ instance SqlType Username where
 
 newtype UserID = UserID {unUserID :: Int} deriving (Show)
 
-newtype BookID = BookID {unBookID :: Int} deriving (Show, ToJSON, FromJSON, FromHttpApiData)
+newtype BookID = BookID {unBookID :: Int} deriving (Show, ToJSON, FromJSON, FromHttpApiData, Eq, Ord)
 
 newtype ChannelID = ChannelID {unChannelID :: Int} deriving (Show)