diff --git a/src/API/Books.hs b/src/API/Books.hs index 646ef7b..0594eb5 100644 --- a/src/API/Books.hs +++ b/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 diff --git a/src/Database/Book.hs b/src/Database/Book.hs index 6f5b9a4..92406ed 100644 --- a/src/Database/Book.hs +++ b/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 diff --git a/src/Database/Schema.hs b/src/Database/Schema.hs index a390bec..f4fcb18 100644 --- a/src/Database/Schema.hs +++ b/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)