Change book schema

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

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]

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

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)