git.iko.soy/denis
on master help sign in
Resolved #25
commitbae9b6a5915fe821f94abb588d53e4122580a807 authoriko <ilyakooo0@gmail.com> dateSun 21 Apr 2019, 22:08 (8 years ago) parentb5aea1f
4 files changed+73−22
compare with master
unifiedsplit
denis/src/Data/Post.hs+12−8 denis/src/Data/PostElement.hs+19−8 denis/src/Data/Query.hs+10−6 denis/src/Data/Sanitizer.hs+32
denis/src/Data/Post.hs+12−8
@@ -15,7 +15,7 @@ module Data.Post (
1515 QuoteId,
1616 PostRowResponse(..),
1717 PostCreation(..)
18−) where
18+) where
1919
2020import Data.Int (Int64)
2121import qualified Generics.SOP as SOP
@@ -29,6 +29,7 @@ import Data.Function (on)
2929import Data.Time.Clock
3030import Data.Time.Calendar
3131import qualified Data.Vector as V
32+import Data.Sanitizer
3233
3334-- MARK: Documentation
3435
@@ -37,10 +38,10 @@ instance ToSample Post where
3738 where time = UTCTime (ModifiedJulianDay 1000) 8
3839
3940instance ToSample PostCreation where
40− toSamples _ = samples $ PostCreation <$> (map snd $ toSamples Proxy) <*> [(V.fromList ["hse", "cs", "machineLearning"])]
41−
41+ toSamples _ = samples $ PostCreation <$> (map snd $ toSamples Proxy) <*> [(V.fromList ["hse", "cs", "machineLearning"])]
4242
43−-- MARK: Actual type
43+
44+-- MARK: Actual type
4445
4546type PostId = Int64
4647type QuoteId = Int64
@@ -59,25 +60,28 @@ instance ToJSON Post where
5960 "authorId" .= aId,
6061 "updated" .= tm,
6162 "tags" .= tags,
62− "body" .= pb ]
63+ "body" .= pb ]
6364
6465data PostCreation = PostCreation {
6566 postCreationBody :: [PostElement Post],
6667 postCreationTags :: V.Vector Text
6768} deriving GHC.Generic
6869
70+instance Sanitizable PostCreation where
71+ sanitize f (PostCreation b t) = PostCreation (sanitize f b) (sanitize f t)
72+
6973instance SOP.Generic PostCreation
7074instance SOP.HasDatatypeInfo PostCreation
7175
7276instance ToJSON PostCreation where
7377 toJSON (PostCreation body tags) = object [
7478 "tags" .= tags,
75− "body" .= body ]
79+ "body" .= body ]
7680
7781instance FromJSON PostCreation where
78− parseJSON = withObject "post creation" $ \e ->
82+ parseJSON = withObject "post creation" $ \e ->
7983 PostCreation <$> e .: "body" <*> e .: "tags"
80−
84+
8185
8286-- MARK: Rows
8387
denis/src/Data/PostElement.hs+19−8
@@ -16,7 +16,7 @@ module Data.PostElement (
1616 MkElementRow,
1717 PostElementRow(..),
1818 elementsToRows
19−) where
19+) where
2020
2121import Data.Int (Int64)
2222import qualified Generics.SOP as SOP
@@ -25,6 +25,7 @@ import Data.Text (Text)
2525import Data.Aeson
2626import Control.Applicative ((<|>))
2727import Servant.Docs (ToSample, toSamples, samples)
28+import Data.Sanitizer
2829
2930-- MARK: Documentation
3031
@@ -43,7 +44,14 @@ data PostElement a = Markdown Text
4344 | Quote PostQuote
4445 | Attachment Text
4546
46−instance ToJSON (PostElement t) where
47+instance {-# Overlapping #-} Sanitizable (PostElement t) where
48+ sanitize f (Markdown m) = Markdown (sanitize f m)
49+ sanitize f (Latex l) = Latex (sanitize f l)
50+ sanitize f (Image i) = Image (sanitize f i)
51+ sanitize f (Quote q) = Quote (sanitize f q)
52+ sanitize f (Attachment a) = Attachment (sanitize f a)
53+
54+instance ToJSON (PostElement t) where
4755 toJSON (Markdown m) = object ["markdown" .= m]
4856 toJSON (Latex l) = object ["latex" .= l]
4957 toJSON (Image i) = object ["image" .= i]
@@ -51,7 +59,7 @@ instance ToJSON (PostElement t) where
5159 toJSON (Attachment a) = object ["attachment" .= a]
5260
5361instance FromJSON (PostElement t) where
54− parseJSON = withObject "post element" $ \e ->
62+ parseJSON = withObject "post element" $ \e ->
5563 Markdown <$> e .: "markdown" <|>
5664 Latex <$> e .: "latex" <|>
5765 Image <$> e .: "image" <|>
@@ -75,7 +83,7 @@ rowsToElement :: MkElementRow (Maybe (PostElement p))
7583rowsToElement (Just m) Nothing Nothing Nothing Nothing = Just $ Markdown m
7684rowsToElement Nothing (Just l) Nothing Nothing Nothing = Just $ Latex l
7785rowsToElement Nothing Nothing (Just i) Nothing Nothing = Just $ Image i
78−-- rowsToElement Nothing Nothing Nothing (Just q) Nothing =
86+-- rowsToElement Nothing Nothing Nothing (Just q) Nothing =
7987-- fmap Quote $ M.lookup q pqrs >>= rowsToQuote erqs pqrs
8088rowsToElement Nothing Nothing Nothing Nothing (Just a) = Just $ Attachment a
8189rowsToElement _ _ _ _ _ = Nothing
@@ -98,7 +106,7 @@ elementsToRows :: Int64 -> [PostElement a] -> [PostElementRow a]
98106elementsToRows pId els = map (\(el, f) -> elemenToRow f el) . zip els . map (PostElementRow pId) $ [0..]
99107
100108
101−-- -- MARK: Quote
109+-- -- MARK: Quote
102110
103111data PostQuote = PostQuote {
104112 quoteId :: Int64,
@@ -106,13 +114,16 @@ data PostQuote = PostQuote {
106114 quotePostId :: Int64
107115}
108116
117+instance Sanitizable PostQuote where
118+ sanitize f (PostQuote qId qB qPId) = PostQuote qId (sanitize f qB) qPId
119+
109120instance ToJSON PostQuote where
110121 toJSON (PostQuote qId pb pId) = object [
111− "id" .= qId,
122+ "id" .= qId,
112123 "postId" .= pId,
113124 "quoteBody" .= pb ]
114125
115−
126+
116127-- -- MARK: PostQuoteRow
117128
118129-- data PostQuoteRow = PostQuoteRow {
@@ -122,7 +133,7 @@ instance ToJSON PostQuote where
122133
123134-- instance SOP.Generic PostQuoteRow
124135-- instance SOP.HasDatatypeInfo PostQuoteRow
125−
136+
126137-- rowsToQuote :: M.Map Int64 [ElementRow PostQuote] -> M.Map Int64 PostQuoteRow -> PostQuoteRow -> Maybe PostQuote
127138-- rowsToQuote erqs pqrs (PostQuoteRow qId pId) = do
128139-- elementRows <- M.lookup qId erqs
denis/src/Data/Query.hs+10−6
@@ -56,10 +56,12 @@ import Data.Aeson
5656import Servant.Docs
5757import Data.Proxy
5858import Data.Vector (Vector, toList, fromList)
59+import qualified Data.Vector as V
5960import Data.Text (Text)
6061import Data.Channel.NamedChannel
6162import Data.Channel.AnonymousChannel
6263import Data.Maybe (fromMaybe)
64+import Data.Sanitizer
6365
6466-- MARK: Documentation
6567
@@ -305,21 +307,23 @@ getAllUsers = runQuery getAllUsersQ >>= getRows
305307
306308publishPost :: UserId -> PostCreation -> StaticPQ PostId
307309publishPost uId pc = commitedTransactionallyUpdate $ do
308− pId' <- manipulateParams createPostRowQ (uId, postCreationTags pc) >>= firstRow
310+ pId' <- manipulateParams createPostRowQ (uId, V.map sanitizeHtml . postCreationTags $ pc) >>= firstRow
309311 case pId' of
310312 (Just (Only pId)) -> do
311− traversePrepared_ createPostElementRowsQ $ elementsToRows pId (postCreationBody pc)
313+ traversePrepared_ createPostElementRowsQ $ elementsToRows pId (sanitizeHtml . postCreationBody $ pc)
312314 return pId
313315 _ -> lift $ S.throwError S.err404
314316
315317createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)
316−createNewChannel uId req = commitedTransactionallyUpdate $ do
317− uIds <- verifiedUsers . toList $ namedChannelCreationRequestPeopleIds req
318− cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow
318+createNewChannel uId (NamedChannelCreationRequest cName cTags cPeople) = commitedTransactionallyUpdate $ do
319+ uIds <- verifiedUsers . toList $ cPeople
320+ cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId
321+ (NamedChannelCreationRequest (sanitizeHtml cName) (sanitizeHtml cTags) (fromList uIds))) >>= firstRow
319322 return $ fmap fromOnly cId
320323
321324updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()
322−updateChannel uId req = commitedTransactionallyUpdate $ do
325+updateChannel uId (NamedChannel nId nName nTags nPeople) = commitedTransactionallyUpdate $ do
326+ let req = NamedChannel nId (sanitizeHtml nName) (sanitizeHtml nTags) nPeople
323327 uIds <- fmap fromList . verifiedUsers . toList $ namedChannelPeopleIds req
324328 _ <- getChannelForUser uId $ namedChannelId req
325329 _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})
denis/src/Data/Sanitizer.hsnew file+32
@@ -0,0 +1,32 @@
1+{-# LANGUAGE OverloadedStrings,
2+ FlexibleInstances #-}
3+
4+module Data.Sanitizer (
5+ sanitizeHtml,
6+ sanitizeHtml',
7+ Sanitizable(..)
8+ ) where
9+
10+import qualified Data.Text as T
11+
12+sanitizeHtml :: Sanitizable s => s -> s
13+sanitizeHtml = sanitize sanitizeHtml'
14+
15+sanitizeHtml' :: T.Text -> T.Text
16+sanitizeHtml' = foldl1 (.) $ map (uncurry T.replace) htmlCharMap
17+
18+htmlCharMap :: [(T.Text, T.Text)]
19+htmlCharMap = [
20+ ("<", "&lt;"),
21+ (">", "&gt;"),
22+ ("&", "&amp;")
23+ ]
24+
25+class Sanitizable s where
26+ sanitize :: (T.Text -> T.Text) -> s -> s
27+
28+instance Sanitizable T.Text where
29+ sanitize = id
30+
31+instance (Sanitizable e, Functor f) => Sanitizable (f e) where
32+ sanitize = fmap . sanitize