git.iko.soy/denis
on master help sign in
Removed the snitizer
dede69biko
denis/src/Data/Post.hs+8−12
compare with master
unifiedsplit
@@ -15,7 +15,7 @@ module Data.Post (
15 QuoteId,
15 QuoteId,
16 PostRowResponse(..),
16 PostRowResponse(..),
17 PostCreation(..)
17 PostCreation(..)
18−) where
18+) where
19
19
20import Data.Int (Int64)
20import Data.Int (Int64)
21import qualified Generics.SOP as SOP
21import qualified Generics.SOP as SOP
@@ -29,7 +29,6 @@ import Data.Function (on)
29import Data.Time.Clock
29import Data.Time.Clock
30import Data.Time.Calendar
30import Data.Time.Calendar
31import qualified Data.Vector as V
31import qualified Data.Vector as V
32−import Data.Sanitizer
33
32
34-- MARK: Documentation
33-- MARK: Documentation
35
34
@@ -38,10 +37,10 @@ instance ToSample Post where
38 where time = UTCTime (ModifiedJulianDay 1000) 8
37 where time = UTCTime (ModifiedJulianDay 1000) 8
39
38
40instance ToSample PostCreation where
39instance ToSample PostCreation where
41− toSamples _ = samples $ PostCreation <$> (map snd $ toSamples Proxy) <*> [(V.fromList ["hse", "cs", "machineLearning"])]
40+ toSamples _ = samples $ PostCreation <$> (map snd $ toSamples Proxy) <*> [(V.fromList ["hse", "cs", "machineLearning"])]
41+
42
42
43−
44−-- MARK: Actual type
43+-- MARK: Actual type
45
44
46type PostId = Int64
45type PostId = Int64
47type QuoteId = Int64
46type QuoteId = Int64
@@ -60,28 +59,25 @@ instance ToJSON Post where
60 "authorId" .= aId,
59 "authorId" .= aId,
61 "updated" .= tm,
60 "updated" .= tm,
62 "tags" .= tags,
61 "tags" .= tags,
63− "body" .= pb ]
62+ "body" .= pb ]
64
63
65data PostCreation = PostCreation {
64data PostCreation = PostCreation {
66 postCreationBody :: [PostElement Post],
65 postCreationBody :: [PostElement Post],
67 postCreationTags :: V.Vector Text
66 postCreationTags :: V.Vector Text
68} deriving GHC.Generic
67} deriving GHC.Generic
69
68
70−instance Sanitizable PostCreation where
71− sanitize f (PostCreation b t) = PostCreation (sanitize f b) (sanitize f t)
72−
73instance SOP.Generic PostCreation
69instance SOP.Generic PostCreation
74instance SOP.HasDatatypeInfo PostCreation
70instance SOP.HasDatatypeInfo PostCreation
75
71
76instance ToJSON PostCreation where
72instance ToJSON PostCreation where
77 toJSON (PostCreation body tags) = object [
73 toJSON (PostCreation body tags) = object [
78 "tags" .= tags,
74 "tags" .= tags,
79− "body" .= body ]
75+ "body" .= body ]
80
76
81instance FromJSON PostCreation where
77instance FromJSON PostCreation where
82− parseJSON = withObject "post creation" $ \e ->
78+ parseJSON = withObject "post creation" $ \e ->
83 PostCreation <$> e .: "body" <*> e .: "tags"
79 PostCreation <$> e .: "body" <*> e .: "tags"
84−
80+
85
81
86-- MARK: Rows
82-- MARK: Rows
87
83
denis/src/Data/PostElement.hs+8−19
@@ -16,7 +16,7 @@ module Data.PostElement (
16 MkElementRow,
16 MkElementRow,
17 PostElementRow(..),
17 PostElementRow(..),
18 elementsToRows
18 elementsToRows
19−) where
19+) where
20
20
21import Data.Int (Int64)
21import Data.Int (Int64)
22import qualified Generics.SOP as SOP
22import qualified Generics.SOP as SOP
@@ -25,7 +25,6 @@ import Data.Text (Text)
25import Data.Aeson
25import Data.Aeson
26import Control.Applicative ((<|>))
26import Control.Applicative ((<|>))
27import Servant.Docs (ToSample, toSamples, samples)
27import Servant.Docs (ToSample, toSamples, samples)
28−import Data.Sanitizer
29
28
30-- MARK: Documentation
29-- MARK: Documentation
31
30
@@ -44,14 +43,7 @@ data PostElement a = Markdown Text
44 | Quote PostQuote
43 | Quote PostQuote
45 | Attachment Text
44 | Attachment Text
46
45
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
46+instance ToJSON (PostElement t) where
55 toJSON (Markdown m) = object ["markdown" .= m]
47 toJSON (Markdown m) = object ["markdown" .= m]
56 toJSON (Latex l) = object ["latex" .= l]
48 toJSON (Latex l) = object ["latex" .= l]
57 toJSON (Image i) = object ["image" .= i]
49 toJSON (Image i) = object ["image" .= i]
@@ -59,7 +51,7 @@ instance ToJSON (PostElement t) where
59 toJSON (Attachment a) = object ["attachment" .= a]
51 toJSON (Attachment a) = object ["attachment" .= a]
60
52
61instance FromJSON (PostElement t) where
53instance FromJSON (PostElement t) where
62− parseJSON = withObject "post element" $ \e ->
54+ parseJSON = withObject "post element" $ \e ->
63 Markdown <$> e .: "markdown" <|>
55 Markdown <$> e .: "markdown" <|>
64 Latex <$> e .: "latex" <|>
56 Latex <$> e .: "latex" <|>
65 Image <$> e .: "image" <|>
57 Image <$> e .: "image" <|>
@@ -83,7 +75,7 @@ rowsToElement :: MkElementRow (Maybe (PostElement p))
83rowsToElement (Just m) Nothing Nothing Nothing Nothing = Just $ Markdown m
75rowsToElement (Just m) Nothing Nothing Nothing Nothing = Just $ Markdown m
84rowsToElement Nothing (Just l) Nothing Nothing Nothing = Just $ Latex l
76rowsToElement Nothing (Just l) Nothing Nothing Nothing = Just $ Latex l
85rowsToElement Nothing Nothing (Just i) Nothing Nothing = Just $ Image i
77rowsToElement Nothing Nothing (Just i) Nothing Nothing = Just $ Image i
86−-- rowsToElement Nothing Nothing Nothing (Just q) Nothing =
78+-- rowsToElement Nothing Nothing Nothing (Just q) Nothing =
87-- fmap Quote $ M.lookup q pqrs >>= rowsToQuote erqs pqrs
79-- fmap Quote $ M.lookup q pqrs >>= rowsToQuote erqs pqrs
88rowsToElement Nothing Nothing Nothing Nothing (Just a) = Just $ Attachment a
80rowsToElement Nothing Nothing Nothing Nothing (Just a) = Just $ Attachment a
89rowsToElement _ _ _ _ _ = Nothing
81rowsToElement _ _ _ _ _ = Nothing
@@ -106,7 +98,7 @@ elementsToRows :: Int64 -> [PostElement a] -> [PostElementRow a]
106elementsToRows pId els = map (\(el, f) -> elemenToRow f el) . zip els . map (PostElementRow pId) $ [0..]
98elementsToRows pId els = map (\(el, f) -> elemenToRow f el) . zip els . map (PostElementRow pId) $ [0..]
107
99
108
100
109−-- -- MARK: Quote
101+-- -- MARK: Quote
110
102
111data PostQuote = PostQuote {
103data PostQuote = PostQuote {
112 quoteId :: Int64,
104 quoteId :: Int64,
@@ -114,16 +106,13 @@ data PostQuote = PostQuote {
114 quotePostId :: Int64
106 quotePostId :: Int64
115}
107}
116
108
117−instance Sanitizable PostQuote where
118− sanitize f (PostQuote qId qB qPId) = PostQuote qId (sanitize f qB) qPId
119−
120instance ToJSON PostQuote where
109instance ToJSON PostQuote where
121 toJSON (PostQuote qId pb pId) = object [
110 toJSON (PostQuote qId pb pId) = object [
122− "id" .= qId,
111+ "id" .= qId,
123 "postId" .= pId,
112 "postId" .= pId,
124 "quoteBody" .= pb ]
113 "quoteBody" .= pb ]
125
114
126−
115+
127-- -- MARK: PostQuoteRow
116-- -- MARK: PostQuoteRow
128
117
129-- data PostQuoteRow = PostQuoteRow {
118-- data PostQuoteRow = PostQuoteRow {
@@ -133,7 +122,7 @@ instance ToJSON PostQuote where
133
122
134-- instance SOP.Generic PostQuoteRow
123-- instance SOP.Generic PostQuoteRow
135-- instance SOP.HasDatatypeInfo PostQuoteRow
124-- instance SOP.HasDatatypeInfo PostQuoteRow
136−
125+
137-- rowsToQuote :: M.Map Int64 [ElementRow PostQuote] -> M.Map Int64 PostQuoteRow -> PostQuoteRow -> Maybe PostQuote
126-- rowsToQuote :: M.Map Int64 [ElementRow PostQuote] -> M.Map Int64 PostQuoteRow -> PostQuoteRow -> Maybe PostQuote
138-- rowsToQuote erqs pqrs (PostQuoteRow qId pId) = do
127-- rowsToQuote erqs pqrs (PostQuoteRow qId pId) = do
139-- elementRows <- M.lookup qId erqs
128-- elementRows <- M.lookup qId erqs
denis/src/Data/Query.hs+6−10
@@ -56,12 +56,10 @@ import Data.Aeson
56import Servant.Docs
56import Servant.Docs
57import Data.Proxy
57import Data.Proxy
58import Data.Vector (Vector, toList, fromList)
58import Data.Vector (Vector, toList, fromList)
59−import qualified Data.Vector as V
60import Data.Text (Text)
59import Data.Text (Text)
61import Data.Channel.NamedChannel
60import Data.Channel.NamedChannel
62import Data.Channel.AnonymousChannel
61import Data.Channel.AnonymousChannel
63import Data.Maybe (fromMaybe)
62import Data.Maybe (fromMaybe)
64−import Data.Sanitizer
65
63
66-- MARK: Documentation
64-- MARK: Documentation
67
65
@@ -307,23 +305,21 @@ getAllUsers = runQuery getAllUsersQ >>= getRows
307
305
308publishPost :: UserId -> PostCreation -> StaticPQ PostId
306publishPost :: UserId -> PostCreation -> StaticPQ PostId
309publishPost uId pc = commitedTransactionallyUpdate $ do
307publishPost uId pc = commitedTransactionallyUpdate $ do
310− pId' <- manipulateParams createPostRowQ (uId, V.map sanitizeHtml . postCreationTags $ pc) >>= firstRow
308+ pId' <- manipulateParams createPostRowQ (uId, postCreationTags pc) >>= firstRow
311 case pId' of
309 case pId' of
312 (Just (Only pId)) -> do
310 (Just (Only pId)) -> do
313− traversePrepared_ createPostElementRowsQ $ elementsToRows pId (sanitizeHtml . postCreationBody $ pc)
311+ traversePrepared_ createPostElementRowsQ $ elementsToRows pId (postCreationBody pc)
314 return pId
312 return pId
315 _ -> lift $ S.throwError S.err404
313 _ -> lift $ S.throwError S.err404
316
314
317createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)
315createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)
318−createNewChannel uId (NamedChannelCreationRequest cName cTags cPeople) = commitedTransactionallyUpdate $ do
316+createNewChannel uId req = commitedTransactionallyUpdate $ do
319− uIds <- verifiedUsers . toList $ cPeople
317+ uIds <- verifiedUsers . toList $ namedChannelCreationRequestPeopleIds req
320− cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId
318+ cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow
321− (NamedChannelCreationRequest (sanitizeHtml cName) (sanitizeHtml cTags) (fromList uIds))) >>= firstRow
322 return $ fmap fromOnly cId
319 return $ fmap fromOnly cId
323
320
324updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()
321updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()
325−updateChannel uId (NamedChannel nId nName nTags nPeople) = commitedTransactionallyUpdate $ do
322+updateChannel uId req = commitedTransactionallyUpdate $ do
326− let req = NamedChannel nId (sanitizeHtml nName) (sanitizeHtml nTags) nPeople
327 uIds <- fmap fromList . verifiedUsers . toList $ namedChannelPeopleIds req
323 uIds <- fmap fromList . verifiedUsers . toList $ namedChannelPeopleIds req
328 _ <- getChannelForUser uId $ namedChannelId req
324 _ <- getChannelForUser uId $ namedChannelId req
329 _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})
325 _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})
denis/src/Data/Sanitizer.hsdeleted−32
@@ -1,32 +0,0 @@
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