View the returned book

- closes #14
This commit is contained in:
Mats Rauhala 2018-08-15 22:08:19 +03:00
parent c05251525b
commit 570cb2fdb2
3 changed files with 21 additions and 8 deletions

View File

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

View File

@ -23,8 +23,11 @@ import Database
import Database.Selda import Database.Selda
import Database.Selda.Generic import Database.Selda.Generic
import Database.Tag (attachTag, clearTags) import Control.Lens (view)
import Database.Channel (attachChannel, clearChannels) import Data.Generics.Product
import Database.Tag (booksTags, attachTag, clearTags)
import Database.Channel (booksChannels, attachChannel, clearChannels)
usersBooks :: (MonadSelda m, MonadMask m, MonadIO m) => Username -> m [Book] usersBooks :: (MonadSelda m, MonadMask m, MonadIO m) => Username -> m [Book]
usersBooks username = fromRels <$> query q usersBooks username = fromRels <$> query q
@ -70,6 +73,7 @@ data UpdateBook = UpdateBook { identifier :: BookID
, owner :: Username , owner :: Username
, tags :: [Text] , tags :: [Text]
, channels :: [Text] } , channels :: [Text] }
deriving (Show, Generic)
bookExists :: (MonadSelda m, MonadMask m, MonadIO m) => BookID -> m Bool bookExists :: (MonadSelda m, MonadMask m, MonadIO m) => BookID -> m Bool
bookExists identifier = not . null <$> query q bookExists identifier = not . null <$> query q
@ -92,23 +96,32 @@ bookOwner' identifier username = do
return (userId :*: bookId) return (userId :*: bookId)
updateBook :: (MonadSelda m, MonadMask m, MonadIO m) => UpdateBook -> m (Maybe UpdateBook) updateBook :: (MonadSelda m, MonadMask m, MonadIO m) => UpdateBook -> m (Maybe UpdateBook)
updateBook book@UpdateBook{..} = do updateBook UpdateBook{..} = do
clearTags identifier >> connectTags clearTags identifier >> connectTags
clearChannels identifier >> connectChannels clearChannels identifier >> connectChannels
updateBook' updateBook'
getUpdateBook identifier owner
where where
connectTags = mapM_ (attachTag owner identifier) tags connectTags = mapM_ (attachTag owner identifier) tags
connectChannels = mapM_ (attachChannel owner identifier) channels connectChannels = mapM_ (attachChannel owner identifier) channels
updateBook' = do updateBook' = do
mUserId <- query (bookOwner' identifier owner) mUserId <- query (bookOwner' identifier owner)
forM (listToMaybe mUserId) $ \_userId -> do forM_ (listToMaybe mUserId) $ \_userId -> do
update_ (gen books) predicate (\b -> b `with` [ pContentType := literal contentType update_ (gen books) predicate (\b -> b `with` [ pContentType := literal contentType
, pTitle := literal title , pTitle := literal title
, pDescription := literal description ]) , pDescription := literal description ])
return book
_ :*: _ :*: pContentType :*: pTitle :*: pDescription :*: _ = selectors (gen books) _ :*: _ :*: pContentType :*: pTitle :*: pDescription :*: _ = selectors (gen books)
predicate (bookId :*: _) = bookId .== literal identifier predicate (bookId :*: _) = bookId .== literal identifier
getUpdateBook :: (MonadMask m, MonadIO m, MonadSelda m) => BookID -> Username -> m (Maybe UpdateBook)
getUpdateBook bookId username = do
mBook <- getBook bookId username
forM mBook $ \Book{..} -> do
channels <- map (view (field @"channel")) <$> booksChannels bookId
tags <- map (view (field @"tag")) <$> booksTags bookId
return UpdateBook{owner=username,..}
setContent :: (MonadSelda m, MonadMask m, MonadIO m) => BookID -> Username -> HashDigest -> m () setContent :: (MonadSelda m, MonadMask m, MonadIO m) => BookID -> Username -> HashDigest -> m ()
setContent identifier owner digest = do setContent identifier owner digest = do
mOwner <- query (bookOwner' identifier owner) mOwner <- query (bookOwner' identifier owner)

View File

@ -39,7 +39,7 @@ insertChannel username channel = do
restrict (user .== literal username) restrict (user .== literal username)
return userId return userId
booksChannels :: (MonadMask m, MonadIO m) => BookID -> SeldaT m [Channel] booksChannels :: (MonadSelda m, MonadMask m, MonadIO m) => BookID -> m [Channel]
booksChannels bookId = fromRels <$> query q booksChannels bookId = fromRels <$> query q
where where
q = do q = do