Change book schema

This commit is contained in:
Mats Rauhala 2018-08-08 21:58:36 +03:00
parent bb7ab38b92
commit d5fb7da13f
5 changed files with 22 additions and 34 deletions

View File

@ -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
) ;

View File

@ -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,..}

View File

@ -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]

View File

@ -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

View File

@ -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)