Modify metadata

This commit is contained in:
Mats Rauhala 2018-08-08 22:21:15 +03:00
parent d5fb7da13f
commit 84a838e141
3 changed files with 32 additions and 2 deletions

View File

@ -64,7 +64,10 @@ postBookMetaHandler auth PostBook{..} = flip requireLoggedIn auth $ \SafeUser{us
putBookMetaHandler :: AuthResult SafeUser -> BookID -> JsonBook -> AppM JsonBook 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 :: AuthResult SafeUser -> AppM [JsonBook]
listBooksHandler = requireLoggedIn $ \user -> do listBooksHandler = requireLoggedIn $ \user -> do

View File

@ -1,9 +1,12 @@
{-# Language TypeApplications #-} {-# Language TypeApplications #-}
{-# Language DataKinds #-} {-# Language DataKinds #-}
{-# Language DuplicateRecordFields #-}
module Database.Book module Database.Book
( def ( def
, insertBook , insertBook
, updateBook
, InsertBook(..) , InsertBook(..)
, UpdateBook(..)
, usersBooks , usersBooks
, Book(..) , Book(..)
, BookID) where , BookID) where
@ -39,3 +42,27 @@ insertBook InsertBook{..} = do
forM (listToMaybe mUserId) $ \userId -> do forM (listToMaybe mUserId) $ \userId -> do
let book = Book{owner=userId,identifier=def,contentHash=Nothing,..} let book = Book{owner=userId,identifier=def,contentHash=Nothing,..}
BookID . fromRowId <$> insertGenWithPK books [book] 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

View File

@ -42,7 +42,7 @@ instance SqlType Username where
newtype UserID = UserID {unUserID :: Int} deriving (Show) 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) newtype ChannelID = ChannelID {unChannelID :: Int} deriving (Show)