master..54410df · denis

git.iko.soy/denis

7 files changed+14−32

unifiedsplit

denis/src/Data/Limits.hs+1−4 denis/src/Data/PostElement.hs+2−8 denis/src/Data/Query.hs+5−5 denis/src/Data/Tags/Validation.hs+3−6 denis/src/Data/Text/Validator.hs+1−1 denis/src/Server/API/Messages.hs+2−7 denis/src/Server/Server.hs−1

denis/src/Data/Limits.hs+1−4

@@ -29,7 +29,4 @@ listLimit :: Int

2929listLimit = 100

3030

3131globalTextLimit :: Int

32−globalTextLimit = 50000

33−

34−groupChatSizeLimit :: Int

35−groupChatSizeLimit = 256

32+globalTextLimit = 50000

denis/src/Data/PostElement.hs+2−8

@@ -16,14 +16,13 @@ module Data.PostElement (

1616 PostElementRow(..),

1717 PostElement(..),

1818 elementsToRows,

19− PostQuote(..),

20− stripPostElement

19+ PostQuote(..)

2120) where

2221

2322import Data.Int (Int64)

2423import qualified Generics.SOP as SOP

2524import qualified GHC.Generics as GHC

26−import Data.Text (Text, strip)

25+import Data.Text (Text)

2726import Data.Aeson

2827import Control.Applicative ((<|>))

2928import Servant.Docs (ToSample, toSamples, samples)

@@ -55,11 +54,6 @@ data PostElement a = Markdown Text

5554 | Attachment Text

5655 deriving (Show, GHC.Generic)

5756

58−stripPostElement :: (PostElement a) -> (PostElement a)

59−stripPostElement (Markdown t) = Markdown (strip t)

60−stripPostElement (Latex t) = Latex (strip t)

61−stripPostElement u = u

62−

6357instance ToJSON (PostElement t) where

6458 toJSON (Markdown m) = object ["markdown" .= m]

6559 toJSON (Latex l) = object ["latex" .= l]

denis/src/Data/Query.hs+5−5

@@ -935,7 +935,7 @@ publishPost uId pc = commitedTransactionallyUpdate $ do

935935 pId' <- manipulateParams createPostRowQ (uId, postCreationTags pc) >>= firstRow

936936 case pId' of

937937 (Just (Only pId)) -> do

938− traversePrepared_ createPostElementRowsQ $ elementsToRows pId (map stripPostElement $ postCreationBody pc)

938+ traversePrepared_ createPostElementRowsQ $ elementsToRows pId (postCreationBody pc)

939939 return pId

940940 _ -> lift $ S.throwError S.err404

941941

@@ -1043,14 +1043,14 @@ getMessagesInGroupChat selfId gId mId lim dir = do

10431043 return . catMaybes . map restoreMessage $ resp

10441044

10451045sendMessage :: UserId -> MessageCreation -> StaticPQ MessageId

1046−sendMessage selfId (MessageCreation (Just gId) uId@Nothing (Jsonb body)) = do

1046+sendMessage selfId (MessageCreation (Just gId) uId@Nothing body) = do

10471047 _ <- getGroupChatForUser selfId gId

1048− (Only mId) <- manipulateParams createMessageQ (selfId, Just gId, uId, Jsonb $ stripPostElement body)

1048+ (Only mId) <- manipulateParams createMessageQ (selfId, Just gId, uId, body)

10491049 >>= firstRow >>= fromMaybe500

10501050 return mId

1051−sendMessage selfId (MessageCreation gId@Nothing (Just uId) (Jsonb body)) = do

1051+sendMessage selfId (MessageCreation gId@Nothing (Just uId) body) = do

10521052 verifyUsers [uId]

1053− (Only mId) <- manipulateParams createMessageQ (selfId, gId, Just uId, Jsonb $ stripPostElement body)

1053+ (Only mId) <- manipulateParams createMessageQ (selfId, gId, Just uId, body)

10541054 >>= firstRow >>= fromMaybe500

10551055 return mId

10561056sendMessage _ _ = lift $ S.throwError S.err400

denis/src/Data/Tags/Validation.hs+3−6

@@ -4,8 +4,7 @@ module Data.Tags.Validation (

44 ) where

66import Data.Text as T

7−import Data.Char as C

8−import qualified Data.Set as S

7+import Data.Char

109validateTag :: T.Text -> Maybe T.Text

1110validateTag tag =

@@ -18,8 +17,6 @@ validateTag tag =

1817validateTag' :: T.Text -> Bool

1918validateTag' = T.all validChar

2019

21−validChars :: S.Set Char

22−validChars = S.fromList "йцукенгшщзхъфывапролджэёячсмитьбюqwertyuiopasdfghjklzxcvbnm1234567890_"

23−

2420validChar :: Char -> Bool

25−validChar c = S.member (C.toLower c) validChars

21+validChar '-' = True

22+validChar c = isAlphaNum c

denis/src/Data/Text/Validator.hs+1−1

@@ -17,7 +17,7 @@ import Data.Limits

1717isValidChar :: Char -> Bool

1818isValidChar '\n' = True

1919isValidChar '\r' = True

20−isValidChar c = isPrint c || generalCategory c == ModifierLetter

20+isValidChar c = isPrint c

2121

2222class HasValidatableText t where

2323 validateText :: t -> Bool

denis/src/Server/API/Messages.hs+2−7

@@ -4,8 +4,7 @@

44 OverloadedLabels,

55 OverloadedStrings ,

66 TypeApplications ,

7− TypeOperators,

8− RecordWildCards #-}

7+ TypeOperators #-}

109module Server.API.Messages (

1110 MessagesApi,

@@ -25,9 +24,6 @@ import Server.Query.Dialog

2524import Data.Text.Validator

2625import Control.Monad

2726import Server.Error

28−import qualified Data.Map as M

29−import Squeal.PostgreSQL.Schema

30−import Data.Limits

3127

3228type GetAllChatsDescription = Description "Gets chats starting from/ending with the given message id."

3329type GetGroupChatDescription = Description "Gets information about a given group chat."

@@ -98,9 +94,8 @@ sendMessageApi uId mes = do

9894 runQerror $ sendMessage uId mes

9995

10096createGroupChatApi :: UserId -> GroupChatCreation -> App GroupChatId

101−createGroupChatApi uId group@GroupChatCreation{..} = do

97+createGroupChatApi uId group = do

10298 unless (validateText group) $ throwError lengthExceeded

103− unless ((M.size $ getJsonb groupChatCreationUsers) < groupChatSizeLimit) $ throwError amountExceeded

10499 runQerror $ createGroupChat uId group

105100

106101leaveChatAPI :: UserId -> GroupChatId -> App NoContent

denis/src/Server/Server.hs−1

@@ -63,7 +63,6 @@ runServer :: IO ()

6363runServer = do

6464 port <- getServerPort

6565 cfg <- getConfig

66− updateFaculties cfg

6766 _ <- periodically (1 * hours) $ updateFaculties cfg

6867 _ <- periodically (20 * minutes) $ runDbTask cfg pruneAuth

6968 let ctx = genAuthServerContext $ getPool cfg