#20 Update privacy settings on channels (#22)

- Closes #20

src/Database/Channel.hs

@@ -4,6 +4,9 @@
 module Database.Channel
   ( userChannels
   , insertChannel
+  , channelExists
+  , isChannelOwner
+  , updateChannelPrivacy
   , attachChannel
   , Visibility(..)
   , clearChannels
@@ -18,6 +21,30 @@ 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
@@ -28,12 +55,25 @@ userChannels username = fromRels <$> query q
       restrict (username' .== literal username)
       return channel
 
-insertChannel :: (MonadMask m, MonadIO m) => Username -> Text -> Visibility -> SeldaT m ()
-insertChannel username channel visibility = do
-  mUserId <- listToMaybe <$> getUser
-  void $ forM mUserId $ \userId ->
-    insertUnless (gen channels) (doesNotExist userId) [ def :*: channel :*: userId :*: visibility ]
+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
   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
     getUser = query $ do
       userId :*: _ :*: user :*: _ <- select (gen users)