diff --git a/src/API/Channels.hs b/src/API/Channels.hs index 2e6c0ed..2321b83 100644 --- a/src/API/Channels.hs +++ b/src/API/Channels.hs @@ -25,14 +25,16 @@ import Data.Aeson import Control.Lens import Data.Generics.Product -data JsonChannel = JsonChannel { channel :: Text } deriving (Show, Generic) +data JsonChannel = JsonChannel { channel :: Text + , visibility :: Visibility } + deriving (Show, Generic) instance ToJSON JsonChannel instance FromJSON JsonChannel type API = Auth '[SA.BasicAuth, SA.Cookie, SA.JWT] SafeUser :> BaseAPI -type BaseAPI = "channels" :> ReqBody '[JSON] JsonChannel :> Put '[JSON] JsonChannel +type BaseAPI = "channels" :> ReqBody '[JSON] JsonChannel :> Post '[JSON] JsonChannel :<|> "channels" :> Get '[JSON] [JsonChannel] handler :: ServerT API AppM @@ -47,5 +49,5 @@ listChannelsHandler = requireLoggedIn $ \user -> newChannelHandler :: AuthResult SafeUser -> JsonChannel -> AppM JsonChannel newChannelHandler auth ch@JsonChannel{..} = flip requireLoggedIn auth $ \user -> do $logInfo $ "Creating channel for user " <> pack (show user) - runDB (insertChannel (view (field @"username") user) channel) + runDB (insertChannel (view (field @"username") user) channel visibility) return ch diff --git a/src/Database/Channel.hs b/src/Database/Channel.hs index db4ca6f..5952f6c 100644 --- a/src/Database/Channel.hs +++ b/src/Database/Channel.hs @@ -5,6 +5,7 @@ module Database.Channel ( userChannels , insertChannel , attachChannel + , Visibility(..) , clearChannels , booksChannels , Channel(..) @@ -27,11 +28,11 @@ userChannels username = fromRels <$> query q restrict (username' .== literal username) return channel -insertChannel :: (MonadMask m, MonadIO m) => Username -> Text -> SeldaT m () -insertChannel username channel = do +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 :*: def ] + insertUnless (gen channels) (doesNotExist userId) [ def :*: channel :*: userId :*: visibility ] where doesNotExist userId (_ :*: channel' :*: userId' :*: _) = channel' .== literal channel .&& userId' .== literal userId getUser = query $ do diff --git a/src/Database/Schema.hs b/src/Database/Schema.hs index 16b1129..cfa07b4 100644 --- a/src/Database/Schema.hs +++ b/src/Database/Schema.hs @@ -127,6 +127,9 @@ data Tag = Tag { identifier :: TagID 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