54410df...master · denis

git.iko.soy/denis

7 files changed+32−14

since splitsnapshots

unifiedsplit

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

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

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

2929listLimit = 100

3030

3131globalTextLimit :: Int

32−globalTextLimit = 50000

32+globalTextLimit = 50000

33+

34+groupChatSizeLimit :: Int

35+groupChatSizeLimit = 256

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

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

1616 PostElementRow(..),

1717 PostElement(..),

1818 elementsToRows,

19− PostQuote(..)

19+ PostQuote(..),

20+ stripPostElement

2021) where

2122

2223import Data.Int (Int64)

2324import qualified Generics.SOP as SOP

2425import qualified GHC.Generics as GHC

25−import Data.Text (Text)

26+import Data.Text (Text, strip)

2627import Data.Aeson

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

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

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

5455 | Attachment Text

5556 deriving (Show, GHC.Generic)

5657

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+

5763instance ToJSON (PostElement t) where

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

5965 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 (postCreationBody pc)

938+ traversePrepared_ createPostElementRowsQ $ elementsToRows pId (map stripPostElement $ 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 body) = do

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

10471047 _ <- getGroupChatForUser selfId gId

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

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

10491049 >>= firstRow >>= fromMaybe500

10501050 return mId

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

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

10521052 verifyUsers [uId]

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

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

10541054 >>= firstRow >>= fromMaybe500

10551055 return mId

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

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

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

44 ) where

66import Data.Text as T

7−import Data.Char

7+import Data.Char as C

8+import qualified Data.Set as S

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

1011validateTag tag =

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

1718validateTag' :: T.Text -> Bool

1819validateTag' = T.all validChar

1920

21+validChars :: S.Set Char

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

23+

2024validChar :: Char -> Bool

21−validChar '-' = True

22−validChar c = isAlphaNum c

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

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

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

2121

2222class HasValidatableText t where

2323 validateText :: t -> Bool

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

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

44 OverloadedLabels,

55 OverloadedStrings ,

66 TypeApplications ,

7− TypeOperators #-}

7+ TypeOperators,

8+ RecordWildCards #-}

910module Server.API.Messages (

1011 MessagesApi,

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

2425import Data.Text.Validator

2526import Control.Monad

2627import Server.Error

28+import qualified Data.Map as M

29+import Squeal.PostgreSQL.Schema

30+import Data.Limits

2731

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

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

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

9498 runQerror $ sendMessage uId mes

9599

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

97−createGroupChatApi uId group = do

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

98102 unless (validateText group) $ throwError lengthExceeded

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

99104 runQerror $ createGroupChat uId group

100105

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

denis/src/Server/Server.hs+1

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

6363runServer = do

6464 port <- getServerPort

6565 cfg <- getConfig

66+ updateFaculties cfg

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

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

6869 let ctx = genAuthServerContext $ getPool cfg