MasseR/ebook-manager
1
0
Fork 0
Code Issues 9 Pull Requests Releases Wiki Activity

#20 Update privacy settings on channels (#22)

Browse Source 
- Closes #20
This commit is contained in:
Mats Rauhala
2018-08-15 23:25:06 +03:00
committed by Gitea
parent e61fb66c06
commit 0037d4691e
3 changed files with 74 additions and 12 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
src/API/Channels.hs
View File

@ -11,6 +11,8 @@
{-# Language FlexibleInstances #-}
{-# Language TypeApplications #-}
{-# Language DataKinds #-}
{-# Language DuplicateRecordFields #-}
{-# Language NamedFieldPuns #-}
module API.Channels (API, handler, JsonChannel(..)) where
import Servant
@ -28,17 +30,34 @@ 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)
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] JsonChannel
type BaseAPI = "channels" :> ReqBody '[JSON] JsonChannel :> Post '[JSON] UpdateChannel
:<|> "channels" :> Capture "channel_id" ChannelID :> ReqBody '[JSON] UpdateChannel :> Put '[JSON] UpdateChannel
:<|> "channels" :> Get '[JSON] [JsonChannel]
handler :: ServerT API AppM
handler user = newChannelHandler user :<|> listChannelsHandler user
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
listChannelsHandler :: AuthResult SafeUser -> AppM [JsonChannel]
listChannelsHandler = requireLoggedIn $ \user ->
@ -46,8 +65,11 @@ 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 JsonChannel
newChannelHandler auth ch@JsonChannel{..} = flip requireLoggedIn auth $ \user -> do
newChannelHandler :: AuthResult SafeUser -> JsonChannel -> AppM UpdateChannel
newChannelHandler auth JsonChannel{..} = flip requireLoggedIn auth $ \user -> do
$logInfo $ "Creating channel for user " <> pack (show user)
runDB (insertChannel (view (field @"username") user) channel visibility)
return ch
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{..}