git.iko.soy/denis
on master help sign in
swap
864681351 ahead, 0 behind
denis/src/Data/PostElement.hs+8−2
since splitsnapshots
unifiedsplit
@@ -16,13 +16,14 @@ module Data.PostElement (
16 PostElementRow(..),
16 PostElementRow(..),
17 PostElement(..),
17 PostElement(..),
18 elementsToRows,
18 elementsToRows,
19− PostQuote(..)
19+ PostQuote(..),
20+ stripPostElement
20) where
21) where
21
22
22import Data.Int (Int64)
23import Data.Int (Int64)
23import qualified Generics.SOP as SOP
24import qualified Generics.SOP as SOP
24import qualified GHC.Generics as GHC
25import qualified GHC.Generics as GHC
25−import Data.Text (Text)
26+import Data.Text (Text, strip)
26import Data.Aeson
27import Data.Aeson
27import Control.Applicative ((<|>))
28import Control.Applicative ((<|>))
28import Servant.Docs (ToSample, toSamples, samples)
29import Servant.Docs (ToSample, toSamples, samples)
@@ -54,6 +55,11 @@ data PostElement a = Markdown Text
54 | Attachment Text
55 | Attachment Text
55 deriving (Show, GHC.Generic)
56 deriving (Show, GHC.Generic)
56
57
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+
57instance ToJSON (PostElement t) where
63instance ToJSON (PostElement t) where
58 toJSON (Markdown m) = object ["markdown" .= m]
64 toJSON (Markdown m) = object ["markdown" .= m]
59 toJSON (Latex l) = object ["latex" .= l]
65 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
935 pId' <- manipulateParams createPostRowQ (uId, postCreationTags pc) >>= firstRow
936 case pId' of
936 case pId' of
937 (Just (Only pId)) -> do
937 (Just (Only pId)) -> do
938− traversePrepared_ createPostElementRowsQ $ elementsToRows pId (postCreationBody pc)
938+ traversePrepared_ createPostElementRowsQ $ elementsToRows pId (map stripPostElement $ postCreationBody pc)
939 return pId
939 return pId
940 _ -> lift $ S.throwError S.err404
940 _ -> lift $ S.throwError S.err404
941
941
@@ -1043,14 +1043,14 @@ getMessagesInGroupChat selfId gId mId lim dir = do
1043 return . catMaybes . map restoreMessage $ resp
1043 return . catMaybes . map restoreMessage $ resp
1044
1044
1045sendMessage :: UserId -> MessageCreation -> StaticPQ MessageId
1045sendMessage :: 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
1047 _ <- getGroupChatForUser selfId gId
1047 _ <- 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)
1049 >>= firstRow >>= fromMaybe500
1049 >>= firstRow >>= fromMaybe500
1050 return mId
1050 return mId
1051−sendMessage selfId (MessageCreation gId@Nothing (Just uId) body) = do
1051+sendMessage selfId (MessageCreation gId@Nothing (Just uId) (Jsonb body)) = do
1052 verifyUsers [uId]
1052 verifyUsers [uId]
1053− (Only mId) <- manipulateParams createMessageQ (selfId, gId, Just uId, body)
1053+ (Only mId) <- manipulateParams createMessageQ (selfId, gId, Just uId, Jsonb $ stripPostElement body)
1054 >>= firstRow >>= fromMaybe500
1054 >>= firstRow >>= fromMaybe500
1055 return mId
1055 return mId
1056sendMessage _ _ = lift $ S.throwError S.err400
1056sendMessage _ _ = lift $ S.throwError S.err400
denis/src/Data/Tags/Validation.hs+6−3
@@ -4,7 +4,8 @@ module Data.Tags.Validation (
4 ) where
4 ) where
5
5
6import Data.Text as T
6import Data.Text as T
7−import Data.Char
7+import Data.Char as C
8+import qualified Data.Set as S
8
9
9validateTag :: T.Text -> Maybe T.Text
10validateTag :: T.Text -> Maybe T.Text
10validateTag tag =
11validateTag tag =
@@ -17,6 +18,8 @@ validateTag tag =
17validateTag' :: T.Text -> Bool
18validateTag' :: T.Text -> Bool
18validateTag' = T.all validChar
19validateTag' = T.all validChar
19
20
21+validChars :: S.Set Char
22+validChars = S.fromList "йцукенгшщзхъфывапролджэёячсмитьбюqwertyuiopasdfghjklzxcvbnm1234567890_"
23+
20validChar :: Char -> Bool
24validChar :: Char -> Bool
21−validChar '-' = True
25+validChar c = S.member (C.toLower c) validChars
22−validChar c = isAlphaNum c