Modify metadata
This commit is contained in:
parent
d5fb7da13f
commit
84a838e141
@ -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
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user