Change book schema
This commit is contained in:
parent
bb7ab38b92
commit
d5fb7da13f
@ -17,7 +17,9 @@ CREATE TABLE public.books (
|
||||
"contentType" text NOT NULL,
|
||||
title text NULL,
|
||||
description text NULL,
|
||||
CONSTRAINT books_pkey PRIMARY KEY (identifier)
|
||||
owner bigserial NOT NULL,
|
||||
CONSTRAINT books_pkey PRIMARY KEY (identifier),
|
||||
CONSTRAINT fk_books_owner FOREIGN KEY (owner) REFERENCES users(identifier)
|
||||
)
|
||||
WITH (
|
||||
OIDS=FALSE
|
||||
@ -60,12 +62,3 @@ CREATE TABLE public.book_tags (
|
||||
WITH (
|
||||
OIDS=FALSE
|
||||
) ;
|
||||
CREATE TABLE public.user_book (
|
||||
"user" bigserial NOT NULL,
|
||||
book int8 NOT NULL,
|
||||
CONSTRAINT fk0_user FOREIGN KEY ("user") REFERENCES users(identifier),
|
||||
CONSTRAINT fk1_book FOREIGN KEY (book) REFERENCES books(identifier)
|
||||
)
|
||||
WITH (
|
||||
OIDS=FALSE
|
||||
) ;
|
||||
|
@ -59,7 +59,7 @@ handler user = listBooksHandler user :<|> postBookMetaHandler user :<|> putBookM
|
||||
|
||||
postBookMetaHandler :: AuthResult SafeUser -> PostBook -> AppM JsonBook
|
||||
postBookMetaHandler auth PostBook{..} = flip requireLoggedIn auth $ \SafeUser{username} -> do
|
||||
mIdentifier <- runDB $ insertBook username Book{identifier=def,contentHash=Nothing,..}
|
||||
mIdentifier <- runDB $ insertBook InsertBook{owner=username,..}
|
||||
maybe (throwM err403{errBody="Could not insert book"}) (\identifier -> pure JsonBook{..}) mIdentifier
|
||||
|
||||
|
||||
@ -70,6 +70,6 @@ listBooksHandler :: AuthResult SafeUser -> AppM [JsonBook]
|
||||
listBooksHandler = requireLoggedIn $ \user -> do
|
||||
runDB (usersBooks (view (field @"username") user) >>= mapM augment)
|
||||
where
|
||||
augment Book{identifier=bookId,..} = do
|
||||
augment Book{identifier=bookId,contentType,title,description} = do
|
||||
channels <- fmap (\Channel{..} -> JsonChannel{..}) <$> booksChannels bookId
|
||||
pure JsonBook{identifier=bookId,..}
|
||||
|
@ -3,6 +3,7 @@
|
||||
module Database.Book
|
||||
( def
|
||||
, insertBook
|
||||
, InsertBook(..)
|
||||
, usersBooks
|
||||
, Book(..)
|
||||
, BookID) where
|
||||
@ -18,21 +19,23 @@ usersBooks username = fromRels <$> query q
|
||||
where
|
||||
q = do
|
||||
userId :*: _ :*: username' :*: _ <- select (gen users)
|
||||
userId' :*: bookHash' <- select (gen userBooks)
|
||||
book@(bookHash :*: _) <- select (gen books)
|
||||
restrict (bookHash .== bookHash')
|
||||
book@(_ :*: _ :*: _ :*: _ :*: _ :*: owner) <- select (gen books)
|
||||
restrict (username' .== literal username)
|
||||
restrict (userId .== userId')
|
||||
restrict (userId .== owner)
|
||||
return book
|
||||
|
||||
data InsertBook = InsertBook { contentType :: Text
|
||||
, title :: Maybe Text
|
||||
, description :: Maybe Text
|
||||
, owner :: Username }
|
||||
|
||||
-- Always inserts
|
||||
insertBook :: (MonadSelda m, MonadMask m, MonadIO m) => Username -> Book -> m (Maybe BookID)
|
||||
insertBook username book = do
|
||||
bookId <- BookID . fromRowId <$> insertGenWithPK books [book]
|
||||
insertBook :: (MonadSelda m, MonadMask m, MonadIO m) => InsertBook -> m (Maybe BookID)
|
||||
insertBook InsertBook{..} = do
|
||||
mUserId <- query $ do
|
||||
userId :*: _ :*: username' :*: _ <- select (gen users)
|
||||
restrict (username' .== literal username)
|
||||
restrict (username' .== literal owner)
|
||||
return userId
|
||||
forM (listToMaybe mUserId) $ \userId -> do
|
||||
void $ insertGen userBooks [UserBook userId bookId]
|
||||
return bookId
|
||||
let book = Book{owner=userId,identifier=def,contentHash=Nothing,..}
|
||||
BookID . fromRowId <$> insertGenWithPK books [book]
|
||||
|
@ -102,7 +102,8 @@ data Book = Book { identifier :: BookID
|
||||
, contentHash :: Maybe HashDigest
|
||||
, contentType :: Text
|
||||
, title :: Maybe Text
|
||||
, description :: Maybe Text }
|
||||
, description :: Maybe Text
|
||||
, owner :: UserID }
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance SqlType HashDigest where
|
||||
@ -112,18 +113,10 @@ instance SqlType HashDigest where
|
||||
defaultValue = mkLit (HashDigest "") -- Doesn't really make sense
|
||||
|
||||
books :: GenTable Book
|
||||
books = genTable "books" [ (identifier :: Book -> BookID) :- autoPrimaryGen ]
|
||||
|
||||
data UserBook = UserBook { user :: UserID
|
||||
, book :: BookID }
|
||||
deriving (Generic, Show)
|
||||
|
||||
userBooks :: GenTable UserBook
|
||||
userBooks = genTable "user_book" [ (user :: UserBook -> UserID) :- fkGen (gen users) userId
|
||||
, (book :: UserBook -> BookID) :- fkGen (gen books) bookHash ]
|
||||
books = genTable "books" [ (identifier :: Book -> BookID) :- autoPrimaryGen
|
||||
, (owner :: Book -> UserID) :- fkGen (gen users) userId ]
|
||||
where
|
||||
userId :*: _ = selectors (gen users)
|
||||
bookHash :*: _ = selectors (gen books)
|
||||
|
||||
-- | Categorizing books
|
||||
data Tag = Tag { identifier :: TagID
|
||||
|
@ -45,7 +45,6 @@ develMain = do
|
||||
migrate = do
|
||||
tryCreateTable (gen users)
|
||||
tryCreateTable (gen books)
|
||||
tryCreateTable (gen userBooks)
|
||||
tryCreateTable (gen tags)
|
||||
tryCreateTable (gen channels)
|
||||
tryCreateTable (gen bookTags)
|
||||
|
Loading…
Reference in New Issue
Block a user