Compare commits
1 Commits
83e39cbe6c
...
13e8da4eea
Author | SHA1 | Date | |
---|---|---|---|
13e8da4eea |
@ -25,7 +25,6 @@ executable ebook-manager
|
||||
, Database
|
||||
, Database.Book
|
||||
, Database.Channel
|
||||
, Database.Tag
|
||||
, Database.Schema
|
||||
, Database.User
|
||||
, Datastore
|
||||
|
@ -1 +0,0 @@
|
||||
alter table channels add column visibility text NOT NULL default 'Private';
|
@ -21,9 +21,9 @@ import ClassyPrelude
|
||||
import Server.Auth
|
||||
import Servant.Auth as SA
|
||||
import Data.Aeson
|
||||
import API.Channels (JsonChannel(..))
|
||||
import Database.Book
|
||||
import Database.Channel
|
||||
import Database.Tag
|
||||
import Database
|
||||
import Control.Lens
|
||||
import Data.Generics.Product
|
||||
@ -38,15 +38,13 @@ data JsonBook = JsonBook { identifier :: BookID
|
||||
, contentType :: Text
|
||||
, title :: Maybe Text
|
||||
, description :: Maybe Text
|
||||
, channels :: [Text]
|
||||
, tags :: [Text] }
|
||||
, channels :: [JsonChannel] }
|
||||
deriving (Generic, Show)
|
||||
|
||||
data PostBook = PostBook { contentType :: Text
|
||||
, title :: Maybe Text
|
||||
, description :: Maybe Text
|
||||
, channels :: [Text]
|
||||
, tags :: [Text] }
|
||||
, channels :: [JsonChannel] }
|
||||
deriving (Generic, Show)
|
||||
|
||||
|
||||
@ -97,9 +95,9 @@ postBookMetaHandler auth PostBook{..} = flip requireLoggedIn auth $ \SafeUser{us
|
||||
|
||||
|
||||
putBookMetaHandler :: AuthResult SafeUser -> BookID -> JsonBook -> AppM JsonBook
|
||||
putBookMetaHandler auth bookId JsonBook{..}
|
||||
putBookMetaHandler auth bookId b@JsonBook{..}
|
||||
| bookId == identifier = requireBookOwner auth bookId $ \SafeUser{username=owner} ->
|
||||
maybe (throwM err403) (return . view (super @JsonBook)) =<< runDB (updateBook UpdateBook{..})
|
||||
maybe (throwM err403) (const (return b)) =<< runDB (updateBook UpdateBook{..})
|
||||
| otherwise = throwM err403
|
||||
|
||||
listBooksHandler :: AuthResult SafeUser -> AppM [JsonBook]
|
||||
@ -107,6 +105,5 @@ listBooksHandler = requireLoggedIn $ \user -> do
|
||||
runDB (usersBooks (view (field @"username") user) >>= mapM augment)
|
||||
where
|
||||
augment Book{identifier=bookId,contentType,title,description} = do
|
||||
channels <- fmap (view (field @"channel")) <$> booksChannels bookId
|
||||
tags <- fmap (view (field @"tag")) <$> booksTags bookId
|
||||
channels <- fmap (\Channel{..} -> JsonChannel{..}) <$> booksChannels bookId
|
||||
pure JsonBook{identifier=bookId,..}
|
||||
|
@ -96,23 +96,9 @@ instance ToNode (Catalog 1) where
|
||||
|
||||
class Monad m => VersionedCatalog m (v :: Nat) where
|
||||
getChannels :: SafeUser -> m (Catalog v)
|
||||
getBooks :: Channel.ChannelID -> SafeUser -> m (Catalog v)
|
||||
|
||||
instance VersionedCatalog AppM 1 where
|
||||
getChannels = getChannelsV1
|
||||
getBooks = getBooksV1
|
||||
|
||||
getBooksV1 :: Channel.ChannelID -> SafeUser -> AppM (Catalog 1)
|
||||
getBooksV1 identifier SafeUser{} = do
|
||||
updated <- liftIO getCurrentTime
|
||||
let self = Rel ("/api/current" <> selfUrl)
|
||||
start = Rel ("/api/current" <> startUrl)
|
||||
selfUrl = pack . uriPath . linkURI $ safeLink (Proxy @(BaseAPI 1)) (Proxy @(ChannelCatalog 1)) identifier
|
||||
startUrl = pack . uriPath . linkURI $ safeLink (Proxy @(BaseAPI 1)) (Proxy @(RootCatalog 1))
|
||||
entries = mempty
|
||||
pagination = Pagination Nothing Nothing
|
||||
pure CatalogV1{..}
|
||||
|
||||
|
||||
getChannelsV1 :: SafeUser -> AppM (Catalog 1)
|
||||
getChannelsV1 SafeUser{username} = do
|
||||
@ -147,7 +133,7 @@ handler auth = catalogRoot :<|> catalogChannels
|
||||
where
|
||||
catalogChannels :: Channel.ChannelID -> AppM (Catalog v)
|
||||
-- Channel specific catalog returns tags inside the catalog
|
||||
catalogChannels identifier = flip requireLoggedIn auth (getBooks identifier)
|
||||
catalogChannels _ = throwM err403{errBody="Not implemented"}
|
||||
catalogRoot :: AppM (Catalog v)
|
||||
-- catalog root returns channels
|
||||
catalogRoot = flip requireLoggedIn auth getChannels
|
||||
|
@ -11,8 +11,6 @@
|
||||
{-# Language FlexibleInstances #-}
|
||||
{-# Language TypeApplications #-}
|
||||
{-# Language DataKinds #-}
|
||||
{-# Language DuplicateRecordFields #-}
|
||||
{-# Language NamedFieldPuns #-}
|
||||
module API.Channels (API, handler, JsonChannel(..)) where
|
||||
|
||||
import Servant
|
||||
@ -27,37 +25,18 @@ import Data.Aeson
|
||||
import Control.Lens
|
||||
import Data.Generics.Product
|
||||
|
||||
data JsonChannel = JsonChannel { channel :: Text
|
||||
, visibility :: Visibility }
|
||||
deriving (Show, Generic)
|
||||
data UpdateChannel = UpdateChannel { identifier :: ChannelID
|
||||
, channel :: Text
|
||||
, visibility :: Visibility }
|
||||
deriving (Show, Generic)
|
||||
data JsonChannel = JsonChannel { channel :: Text } deriving (Show, Generic)
|
||||
|
||||
instance ToJSON JsonChannel
|
||||
instance FromJSON JsonChannel
|
||||
instance ToJSON UpdateChannel
|
||||
instance FromJSON UpdateChannel
|
||||
|
||||
type API = Auth '[SA.BasicAuth, SA.Cookie, SA.JWT] SafeUser :> BaseAPI
|
||||
|
||||
type BaseAPI = "channels" :> ReqBody '[JSON] JsonChannel :> Post '[JSON] UpdateChannel
|
||||
:<|> "channels" :> Capture "channel_id" ChannelID :> ReqBody '[JSON] UpdateChannel :> Put '[JSON] UpdateChannel
|
||||
type BaseAPI = "channels" :> ReqBody '[JSON] JsonChannel :> Put '[JSON] JsonChannel
|
||||
:<|> "channels" :> Get '[JSON] [JsonChannel]
|
||||
|
||||
handler :: ServerT API AppM
|
||||
handler user = newChannelHandler user :<|> updateChannelHandler user :<|> listChannelsHandler user
|
||||
|
||||
requireChannelOwner :: AuthResult SafeUser -> ChannelID -> (SafeUser -> AppM a) -> AppM a
|
||||
requireChannelOwner auth channelId f = flip requireLoggedIn auth $ \u@SafeUser{username} -> do
|
||||
unlessM (runDB . channelExists $ channelId) $ throwM err404
|
||||
runDB (isChannelOwner channelId username) >>= \o -> if o then f u else throwM err403
|
||||
|
||||
updateChannelHandler :: AuthResult SafeUser -> ChannelID -> UpdateChannel -> AppM UpdateChannel
|
||||
updateChannelHandler auth channelId UpdateChannel{visibility} = requireChannelOwner auth channelId $ \_ -> do
|
||||
mChannel <- fmap toChannel <$> runDB (updateChannelPrivacy channelId visibility)
|
||||
maybe (throwM err403) return mChannel
|
||||
handler user = newChannelHandler user :<|> listChannelsHandler user
|
||||
|
||||
listChannelsHandler :: AuthResult SafeUser -> AppM [JsonChannel]
|
||||
listChannelsHandler = requireLoggedIn $ \user ->
|
||||
@ -65,11 +44,8 @@ listChannelsHandler = requireLoggedIn $ \user ->
|
||||
-- use the 'channel' accessor somehow or export it
|
||||
fmap (\Channel{..} -> JsonChannel{..}) <$> runDB (userChannels (view (field @"username") user))
|
||||
|
||||
newChannelHandler :: AuthResult SafeUser -> JsonChannel -> AppM UpdateChannel
|
||||
newChannelHandler auth JsonChannel{..} = flip requireLoggedIn auth $ \user -> do
|
||||
newChannelHandler :: AuthResult SafeUser -> JsonChannel -> AppM JsonChannel
|
||||
newChannelHandler auth ch@JsonChannel{..} = flip requireLoggedIn auth $ \user -> do
|
||||
$logInfo $ "Creating channel for user " <> pack (show user)
|
||||
mChannel <- fmap toChannel <$> runDB (insertChannel (view (field @"username") user) channel visibility)
|
||||
maybe (throwM err403{errBody="Could not create the channel"}) return mChannel
|
||||
|
||||
toChannel :: Channel -> UpdateChannel
|
||||
toChannel Channel{..} = UpdateChannel{..}
|
||||
runDB (insertChannel (view (field @"username") user) channel)
|
||||
return ch
|
||||
|
@ -11,7 +11,6 @@ module Database
|
||||
, fromRel
|
||||
, fromRels
|
||||
, toRel
|
||||
, transaction
|
||||
, SeldaT )
|
||||
where
|
||||
|
||||
@ -19,7 +18,7 @@ import Data.Generics.Product
|
||||
import Control.Lens (view)
|
||||
import Data.Pool (Pool, withResource)
|
||||
import Database.Selda.Backend (SeldaConnection, runSeldaT, SeldaT)
|
||||
import Database.Selda (query, select, transaction)
|
||||
import Database.Selda (query, select)
|
||||
import Database.Selda.Generic (gen, fromRel, fromRels, toRel)
|
||||
import ClassyPrelude
|
||||
|
||||
|
@ -18,17 +18,11 @@ module Database.Book
|
||||
, BookID) where
|
||||
|
||||
import ClassyPrelude
|
||||
import Database.Schema (books, users, Username, Book(..), BookID(..), UserID, HashDigest(..))
|
||||
import Database.Schema
|
||||
import Database
|
||||
import Database.Selda
|
||||
import Database.Selda.Generic
|
||||
|
||||
import Control.Lens (view)
|
||||
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 username = fromRels <$> query q
|
||||
where
|
||||
@ -70,10 +64,7 @@ data UpdateBook = UpdateBook { identifier :: BookID
|
||||
, contentType :: Text
|
||||
, title :: Maybe Text
|
||||
, description :: Maybe Text
|
||||
, owner :: Username
|
||||
, tags :: [Text]
|
||||
, channels :: [Text] }
|
||||
deriving (Show, Generic)
|
||||
, owner :: Username }
|
||||
|
||||
bookExists :: (MonadSelda m, MonadMask m, MonadIO m) => BookID -> m Bool
|
||||
bookExists identifier = not . null <$> query q
|
||||
@ -96,32 +87,17 @@ bookOwner' identifier username = do
|
||||
return (userId :*: bookId)
|
||||
|
||||
updateBook :: (MonadSelda m, MonadMask m, MonadIO m) => UpdateBook -> m (Maybe UpdateBook)
|
||||
updateBook UpdateBook{..} = do
|
||||
clearTags identifier >> connectTags
|
||||
clearChannels identifier >> connectChannels
|
||||
updateBook'
|
||||
getUpdateBook identifier owner
|
||||
where
|
||||
connectTags = mapM_ (attachTag owner identifier) tags
|
||||
connectChannels = mapM_ (attachChannel owner identifier) channels
|
||||
updateBook' = do
|
||||
updateBook book@UpdateBook{..} = do
|
||||
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
|
||||
, pTitle := literal title
|
||||
, pDescription := literal description ])
|
||||
return book
|
||||
where
|
||||
_ :*: _ :*: pContentType :*: pTitle :*: pDescription :*: _ = selectors (gen books)
|
||||
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 identifier owner digest = do
|
||||
mOwner <- query (bookOwner' identifier owner)
|
||||
|
@ -1,15 +1,8 @@
|
||||
{-# Language TypeApplications #-}
|
||||
{-# Language DataKinds #-}
|
||||
{-# Language NamedFieldPuns #-}
|
||||
module Database.Channel
|
||||
( userChannels
|
||||
, insertChannel
|
||||
, channelExists
|
||||
, isChannelOwner
|
||||
, updateChannelPrivacy
|
||||
, attachChannel
|
||||
, Visibility(..)
|
||||
, clearChannels
|
||||
, booksChannels
|
||||
, Channel(..)
|
||||
, ChannelID )
|
||||
@ -19,95 +12,35 @@ import ClassyPrelude
|
||||
import Database.Schema
|
||||
import Database
|
||||
import Database.Selda
|
||||
import Database.Selda.Generic
|
||||
|
||||
import Control.Monad.Trans.Maybe
|
||||
|
||||
getChannel :: (MonadSelda m, MonadMask m, MonadIO m) => ChannelID -> m (Maybe Channel)
|
||||
getChannel identifier = listToMaybe . fromRels <$> query q
|
||||
where
|
||||
q = do
|
||||
ch@(channelId :*: _) <- select (gen channels)
|
||||
restrict (channelId .== literal identifier)
|
||||
return ch
|
||||
|
||||
channelExists :: (MonadSelda m, MonadMask m, MonadIO m) => ChannelID -> m Bool
|
||||
channelExists identifier = not . null <$> getChannel identifier
|
||||
|
||||
isChannelOwner :: (MonadSelda m, MonadIO m, MonadMask m) => ChannelID -> Username -> m Bool
|
||||
isChannelOwner identifier username = not . null <$> query q
|
||||
where
|
||||
q = do
|
||||
userId :*: _ :*: username' :*: _ <- select (gen users)
|
||||
channelId :*: _ :*: channelOwner :*: _ <- select (gen channels)
|
||||
restrict (userId .== channelOwner)
|
||||
restrict (username' .== literal username)
|
||||
restrict (channelId .== literal identifier)
|
||||
return channelId
|
||||
|
||||
userChannels :: (MonadMask m, MonadIO m) => Username -> SeldaT m [Channel]
|
||||
userChannels username = fromRels <$> query q
|
||||
where
|
||||
q = do
|
||||
userId :*: _ :*: username' :*: _ <- select (gen users)
|
||||
channel@(_ :*: _ :*: owner :*: _) <- select (gen channels)
|
||||
channel@(_ :*: _ :*: owner) <- select (gen channels)
|
||||
restrict (owner .== userId)
|
||||
restrict (username' .== literal username)
|
||||
return channel
|
||||
|
||||
updateChannelPrivacy :: (MonadMask m, MonadIO m, MonadSelda m) => ChannelID -> Visibility -> m (Maybe Channel)
|
||||
updateChannelPrivacy channelId visibility = do
|
||||
void $ update (gen channels) predicate (\channel -> channel `with` [pVis := literal visibility])
|
||||
getChannel channelId
|
||||
insertChannel :: (MonadMask m, MonadIO m) => Username -> Text -> SeldaT m ()
|
||||
insertChannel username channel = do
|
||||
mUserId <- listToMaybe <$> getUser
|
||||
void $ forM mUserId $ \userId ->
|
||||
insertUnless (gen channels) (doesNotExist userId) [ def :*: channel :*: userId ]
|
||||
where
|
||||
predicate (channelId' :*: _) = channelId' .== literal channelId
|
||||
_ :*: _ :*: _ :*: pVis = selectors (gen channels)
|
||||
|
||||
insertChannel :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> Text -> Visibility -> m (Maybe Channel)
|
||||
insertChannel username channel visibility = runMaybeT $ do
|
||||
userId <- MaybeT (listToMaybe <$> getUser)
|
||||
channelId <- toChannelId <$> MaybeT (insertUnless (gen channels) (doesNotExist userId) [ def :*: channel :*: userId :*: visibility ])
|
||||
MaybeT (listToMaybe . fromRels <$> query (q channelId))
|
||||
where
|
||||
q channelId = do
|
||||
ch@(channelId' :*: _) <- select (gen channels)
|
||||
restrict (channelId' .== literal channelId)
|
||||
return ch
|
||||
toChannelId = ChannelID . fromRowId
|
||||
doesNotExist userId (_ :*: channel' :*: userId' :*: _) = channel' .== literal channel .&& userId' .== literal userId
|
||||
doesNotExist userId (_ :*: channel' :*: userId') = channel' .== literal channel .&& userId' .== literal userId
|
||||
getUser = query $ do
|
||||
userId :*: _ :*: user :*: _ <- select (gen users)
|
||||
restrict (user .== literal username)
|
||||
return userId
|
||||
|
||||
booksChannels :: (MonadSelda m, MonadMask m, MonadIO m) => BookID -> m [Channel]
|
||||
booksChannels bookId = fromRels <$> query q
|
||||
booksChannels :: (MonadMask m, MonadIO m) => BookID -> SeldaT m [Channel]
|
||||
booksChannels contentHash = fromRels <$> query q
|
||||
where
|
||||
q = do
|
||||
channelId :*: bookId' <- select (gen bookChannels)
|
||||
channelId :*: contentHash' <- select (gen bookChannels)
|
||||
ch@(channelId' :*: _) <- select (gen channels)
|
||||
restrict (channelId .== channelId')
|
||||
restrict (bookId' .== literal bookId)
|
||||
restrict (contentHash' .== literal contentHash)
|
||||
return ch
|
||||
|
||||
attachChannel :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> BookID -> Text -> m ()
|
||||
attachChannel username bookId channel = do
|
||||
mCh <- fromRels <$> query channelQ
|
||||
forM_ mCh $ \Channel{identifier} ->
|
||||
whenM (null <$> query (attachQ identifier)) $
|
||||
void $ insertGen bookChannels [BookChannel identifier bookId]
|
||||
where
|
||||
attachQ channelId = do
|
||||
(channelId' :*: bookId') <- select (gen bookChannels)
|
||||
restrict (channelId' .== literal channelId .&& bookId' .== literal bookId)
|
||||
return channelId'
|
||||
channelQ = do
|
||||
userId :*: _ :*: username' :*: _ <- select (gen users)
|
||||
ch@(_ :*: channel' :*: owner :*: _) <- select (gen channels)
|
||||
restrict (username' .== literal username)
|
||||
restrict (owner .== userId)
|
||||
restrict (channel' .== literal channel)
|
||||
return ch
|
||||
|
||||
clearChannels :: (MonadMask m, MonadIO m, MonadSelda m) => BookID -> m Int
|
||||
clearChannels bookId = deleteFrom (gen bookChannels) (\(_ :*: bookId') -> bookId' .== literal bookId)
|
||||
|
@ -44,7 +44,7 @@ newtype UserID = UserID {unUserID :: Int} deriving (Show)
|
||||
|
||||
newtype BookID = BookID {unBookID :: Int} deriving (Show, ToJSON, FromJSON, FromHttpApiData, Eq, Ord)
|
||||
|
||||
newtype ChannelID = ChannelID {unChannelID :: Int} deriving (Show, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON)
|
||||
newtype ChannelID = ChannelID {unChannelID :: Int} deriving (Show, ToHttpApiData, FromHttpApiData)
|
||||
|
||||
newtype TagID = TagID {unTagID :: Int} deriving (Show)
|
||||
|
||||
@ -124,22 +124,9 @@ data Tag = Tag { identifier :: TagID
|
||||
, owner :: UserID }
|
||||
deriving (Show, Generic)
|
||||
|
||||
data Visibility = Public | Private | Followers
|
||||
deriving (Show, Read, Generic)
|
||||
|
||||
instance ToJSON Visibility
|
||||
instance FromJSON Visibility
|
||||
|
||||
instance SqlType Visibility where
|
||||
mkLit = LCustom . LText . pack . show
|
||||
fromSql (SqlString x) = fromMaybe (error "fromSql: Not a valid visibility token") . readMay . unpack $ x
|
||||
fromSql _ = error "fromSql: Not a valid visibility token"
|
||||
defaultValue = mkLit Private
|
||||
|
||||
data Channel = Channel { identifier :: ChannelID
|
||||
, channel :: Text
|
||||
, owner :: UserID
|
||||
, visibility :: Visibility }
|
||||
, owner :: UserID }
|
||||
deriving (Show, Generic)
|
||||
|
||||
tags :: GenTable Tag
|
||||
|
@ -1,61 +0,0 @@
|
||||
{-# Language TypeApplications #-}
|
||||
{-# Language TypeOperators #-}
|
||||
{-# Language DataKinds #-}
|
||||
{-# Language DuplicateRecordFields #-}
|
||||
{-# Language NamedFieldPuns #-}
|
||||
module Database.Tag
|
||||
( def
|
||||
, booksTags
|
||||
, attachTag
|
||||
, upsertTag
|
||||
, clearTags
|
||||
, Tag(..) ) where
|
||||
|
||||
import ClassyPrelude
|
||||
import Database.Schema
|
||||
import Database
|
||||
import Database.Selda
|
||||
import Database.Selda.Generic
|
||||
import Control.Monad.Trans.Maybe
|
||||
|
||||
upsertTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> Text -> m (Maybe Tag)
|
||||
upsertTag username tag = runMaybeT $ do
|
||||
userId <- MaybeT (listToMaybe <$> query userQ)
|
||||
void $ lift $ upsert (gen tags) (predicate userId) id [toRel (Tag def tag userId)]
|
||||
MaybeT (listToMaybe . fromRels <$> query (tagQ userId))
|
||||
where
|
||||
predicate userId (_ :*: tag' :*: owner) = tag' .== literal tag .&& owner .== literal userId
|
||||
tagQ userId = do
|
||||
t@(_ :*: tag' :*: owner) <- select (gen tags)
|
||||
restrict (tag' .== literal tag .&& owner .== literal userId)
|
||||
return t
|
||||
userQ = do
|
||||
userId :*: _ :*: username' :*: _ <- select (gen users)
|
||||
restrict (username' .== literal username)
|
||||
return userId
|
||||
|
||||
booksTags :: (MonadMask m, MonadIO m, MonadSelda m) => BookID -> m [Tag]
|
||||
booksTags bookId = fromRels <$> query q
|
||||
where
|
||||
q = do
|
||||
tagId :*: bookId' <- select (gen bookTags)
|
||||
tag@(tagId' :*: _) <- select (gen tags)
|
||||
restrict (tagId .== tagId')
|
||||
restrict (bookId' .== literal bookId)
|
||||
return tag
|
||||
|
||||
attachTag :: (MonadMask m, MonadIO m, MonadSelda m) => Username -> BookID -> Text -> m ()
|
||||
attachTag username bookId tag = do
|
||||
maybeT <- upsertTag username tag
|
||||
forM_ maybeT $ \Tag{identifier} -> do
|
||||
whenM (null <$> query (tagQ identifier)) $
|
||||
void $ insertGen bookTags [BookTag identifier bookId]
|
||||
where
|
||||
tagQ tagId = do
|
||||
(tagId' :*: bookId') <- select (gen bookTags)
|
||||
restrict (tagId' .== literal tagId .&& bookId' .== literal bookId)
|
||||
return tagId'
|
||||
|
||||
clearTags :: (MonadMask m, MonadIO m, MonadSelda m) => BookID -> m Int
|
||||
clearTags bookId = deleteFrom (gen bookTags) (\(_ :*: bookId') -> bookId' .== literal bookId)
|
||||
|
Loading…
Reference in New Issue
Block a user