master..54410df · denis

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

since splitsnapshots

unifiedsplit

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

29listLimit = 100

30

31globalTextLimit :: Int

32−globalTextLimit = 50000

32+globalTextLimit = 50000

33−

34−groupChatSizeLimit :: Int

35−groupChatSizeLimit = 256

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

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

16 PostElementRow(..),

17 PostElement(..),

18 elementsToRows,

19− PostQuote(..),

19+ PostQuote(..)

20− stripPostElement

21) where

20) where

22

21

23import Data.Int (Int64)

22import Data.Int (Int64)

24import qualified Generics.SOP as SOP

23import qualified Generics.SOP as SOP

25import qualified GHC.Generics as GHC

24import qualified GHC.Generics as GHC

26−import Data.Text (Text, strip)

25+import Data.Text (Text)

27import Data.Aeson

26import Data.Aeson

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

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

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

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

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

55 | Attachment Text

54 | Attachment Text

56 deriving (Show, GHC.Generic)

55 deriving (Show, GHC.Generic)

57

56

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−

63instance ToJSON (PostElement t) where

57instance ToJSON (PostElement t) where

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

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

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

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

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

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

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

936 case pId' of

937 (Just (Only pId)) -> do

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

938+ traversePrepared_ createPostElementRowsQ $ elementsToRows pId (postCreationBody pc)

939 return pId

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

941

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

1043 return . catMaybes . map restoreMessage $ resp

1044

1045sendMessage :: 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

1047 _ <- 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)

1049 >>= firstRow >>= fromMaybe500

1050 return mId

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

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

1052 verifyUsers [uId]

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

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

1054 >>= firstRow >>= fromMaybe500

1055 return mId

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

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

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

4 ) where

5

6import Data.Text as T

7−import Data.Char as C

7+import Data.Char

8−import qualified Data.Set as S

9

8

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

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

11validateTag tag =

10validateTag tag =

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

18validateTag' :: T.Text -> Bool

17validateTag' :: T.Text -> Bool

19validateTag' = T.all validChar

18validateTag' = T.all validChar

20

19

21−validChars :: S.Set Char

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

23−

24validChar :: Char -> Bool

20validChar :: 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

17isValidChar :: Char -> Bool

18isValidChar '\n' = True

19isValidChar '\r' = True

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

20+isValidChar c = isPrint c

21

22class HasValidatableText t where

23 validateText :: t -> Bool

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

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

4 OverloadedLabels,

5 OverloadedStrings ,

6 TypeApplications ,

7− TypeOperators,

7+ TypeOperators #-}

8− RecordWildCards #-}

9

8

10module Server.API.Messages (

9module Server.API.Messages (

11 MessagesApi,

10 MessagesApi,

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

25import Data.Text.Validator

24import Data.Text.Validator

26import Control.Monad

25import Control.Monad

27import Server.Error

26import Server.Error

28−import qualified Data.Map as M

29−import Squeal.PostgreSQL.Schema

30−import Data.Limits

31

27

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

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

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

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

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

98 runQerror $ sendMessage uId mes

94 runQerror $ sendMessage uId mes

99

95

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

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

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

97+createGroupChatApi uId group = do

102 unless (validateText group) $ throwError lengthExceeded

98 unless (validateText group) $ throwError lengthExceeded

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

104 runQerror $ createGroupChat uId group

99 runQerror $ createGroupChat uId group

105

100

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

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

denis/src/Server/Server.hs−1

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

63runServer = do

64 port <- getServerPort

65 cfg <- getConfig

66− updateFaculties cfg

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

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

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

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

69 let ctx = genAuthServerContext $ getPool cfg

68 let ctx = genAuthServerContext $ getPool cfg