parent
c05251525b
commit
570cb2fdb2
@ -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]
|
||||||
|
@ -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)
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user