diff --git a/migrations/V1__Initial_database.sql b/migrations/V1__Initial_database.sql index 43d0673..3e919bd 100644 --- a/migrations/V1__Initial_database.sql +++ b/migrations/V1__Initial_database.sql @@ -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 -) ; diff --git a/src/API/Books.hs b/src/API/Books.hs index 4943a60..646ef7b 100644 --- a/src/API/Books.hs +++ b/src/API/Books.hs @@ -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,..} diff --git a/src/Database/Book.hs b/src/Database/Book.hs index 3af9f79..6f5b9a4 100644 --- a/src/Database/Book.hs +++ b/src/Database/Book.hs @@ -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] diff --git a/src/Database/Schema.hs b/src/Database/Schema.hs index 0162fa3..a390bec 100644 --- a/src/Database/Schema.hs +++ b/src/Database/Schema.hs @@ -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 diff --git a/src/Devel/Main.hs b/src/Devel/Main.hs index a8d2893..fb20ded 100644 --- a/src/Devel/Main.hs +++ b/src/Devel/Main.hs @@ -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)