on master help sign in
Merge pull request #136 from ilyakooo0/develop

Develop

commit14671e10278df7318609081a34f0eed10db4da33 authoriko <ilyakooo0@gmail.com> dateSun 12 May 2019, 17:14 (7 years ago) parent20617bad3d6e79
5 files changed+34−7
denis/src/Data/Query.hs+10−1 denis/src/Server/API/Channels.hs+12−2 denis/src/Server/Auth/Token.hs+1−1 denis/src/Server/Error.hs+10−2 denis/src/Server/Server.hs+1−1
denis/src/Data/Query.hs+10−1
@@ -60,7 +60,8 @@ module Data.Query (
6060 searchTags,
6161 updateUser,
6262 UserUpdateRow(..),
63− killAllTokens
63+ killAllTokens,
64+ channelCountForUser
6465 ) where
6566
6667import Squeal.PostgreSQL
@@ -337,6 +338,11 @@ createNamedChannelQ = insertRow #channels
337338 OnConflictDoRaise
338339 (Returning $ #namedChannelFullId `as` #fromOnly)
339340
341+countChannelsQ :: Query Schema (TuplePG (Only UserId)) (RowPG (Only Int64))
342+countChannelsQ = select (countStar `as` #fromOnly) (from (table #channels) &
343+ where_ (#namedChannelFullOwner .== param @1) &
344+ groupBy #namedChannelFullOwner)
345+
340346deleteNamedChannelQ :: Manipulation Schema (TuplePG (Only NamedChannelId)) '[]
341347deleteNamedChannelQ = deleteFrom_ #channels (#namedChannelFullId .== param @1)
342348
@@ -897,6 +903,9 @@ createNewChannel uId req = commitedTransactionallyUpdate $ do
897903 cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow
898904 return $ fmap fromOnly cId
899905
906+channelCountForUser :: UserId -> StaticPQ Int64
907+channelCountForUser uId = (fromMaybe 0 . fmap fromOnly) <$> (runQueryParams countChannelsQ (Only uId) >>= firstRow)
908+
900909updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()
901910updateChannel uId req = commitedTransactionallyUpdate $ do
902911 uIds <- fmap fromList . verifiedUsers . toList $ namedChannelPeopleIds req
denis/src/Server/API/Channels.hs+12−2
@@ -21,6 +21,8 @@ import Data.Channel.NamedChannel
2121import Data.Channel.AnonymousChannel
2222import qualified Data.Post as P
2323import Server.Query.Pagination
24+import Data.Int
25+import Server.Error
2426
2527-- MARK: Implementation
2628
@@ -47,7 +49,11 @@ getChannel uId (PaginatingRequest pId lim (Just cId) dir) = runQnotFound $ getCh
4749getChannel _ (PaginatingRequest pId lim Nothing dir) = maybeNotFound . runQnotFound $ getLastPosts pId lim dir
4850
4951createChannelApi :: UserId -> NamedChannelCreationRequest -> App NamedChannelId
50−createChannelApi uId req = maybeNotFound . runQnotFound $ createNewChannel uId req
52+createChannelApi uId req = do
53+ cCount <- runQerror $ channelCountForUser uId
54+ if cCount >= channelCountLimit
55+ then throwError $ limitExceeded "You have exceeded the number of channels you can create."
56+ else maybeNotFound . runQerror $ createNewChannel uId req
5157
5258updateChannelApi :: UserId -> NamedChannel UserId -> App NoContent
5359updateChannelApi uId req = do
@@ -57,4 +63,8 @@ updateChannelApi uId req = do
5763deleteChannelApi :: UserId -> NamedChannelId -> App NoContent
5864deleteChannelApi uId cId = do
5965 runQnotFound $ deleteNamedChannel uId cId
60− return NoContent
66+ return NoContent
67+
68+-- TODO: Increase
69+channelCountLimit :: Int64
70+channelCountLimit = 5
denis/src/Server/Auth/Token.hs+1−1
@@ -63,7 +63,7 @@ generateTokenM = do
6363 activationToken <- randomBytes 64
6464 deactivationToken <- randomBytes 64
6565 code <- randomR (0, 999999)
66− expire <- liftIO $ fmap (addUTCTime (60*30 {- 30 minutes -} {- nominalDay * 365 -})) getCurrentTime -- one year
66+ expire <- liftIO $ fmap (addUTCTime (nominalDay * 365)) getCurrentTime -- one year
6767 return $ \ uId ua -> GeneratedToken {
6868 generatedToken = Token uId (hash token) expire (Just . hashVerificationCode $ code) 10 ua (Just . hash $ activationToken) (hash deactivationToken),
6969 generatedTokenValue = token,
denis/src/Server/Error.hs+10−2
@@ -1,15 +1,23 @@
11{-# LANGUAGE OverloadedStrings #-}
22
33module Server.Error (
4− invalidToken
4+ invalidToken,
5+ limitExceeded,
6+ throwError
57) where
68
79import Servant.Server
10+import Control.Monad.Except
811
912invalidToken :: ServantErr
1013invalidToken = ServantErr {
1114 errHTTPCode = 498,
1215 errReasonPhrase = "Invalid Token",
13− errBody = "The supplied token is invalid",
16+ errBody = "",
1417 errHeaders = []
1518}
19+
20+limitExceeded :: String -> ServantErr
21+limitExceeded msg = err406 {
22+ errReasonPhrase = msg
23+}
denis/src/Server/Server.hs+1−1
@@ -55,7 +55,7 @@ runServer = do
5555 cfg <- getConfig
5656 void . forkIO $ updateFaculties cfg
5757 let ctx = genAuthServerContext $ getPool cfg
58− (middleLogger, logger) <- mkLogger 100
58+ (middleLogger, logger) <- mkLogger 500
5959 let serverAPI = mkServerAPI logger
6060 let s = hoistServerWithContext serverProxy contextProxy (flip runReaderT cfg) serverAPI
6161 runSettings (settings port) $ cors (const $ Just policy) . middleLogger $ serveWithContext serverProxy ctx s