git.iko.soy/denis
on master help sign in
swap
864681380 ahead, 0 behind
Procfile+1−1
since splitsnapshots
unifiedsplit
@@ -1 +1 @@
1−web: denis-exe
1+web: denis-exe +RTS -N
denis/email.html+2−3
@@ -1,8 +1,7 @@
1<html>
1<html>
2
2
3<body style="font-family: sans-serif;">
3<body style="font-family: sans-serif;">
4− <h1>
5− <div align="center" style="margin-top: 20vh;">
4+ <div style="text-align: center; margin-top: 55px;">
6 <a href="#" style="font-size: 34px; font-weight: bold; display: inline-block; padding: 7px 13px 7px 13px; margin-bottom: 89px; text-decoration: underline; font-family: sans-serif; color: #555;">
5 <a href="#" style="font-size: 34px; font-weight: bold; display: inline-block; padding: 7px 13px 7px 13px; margin-bottom: 89px; text-decoration: underline; font-family: sans-serif; color: #555;">
7 Log in
6 Log in
8 </a>
7 </a>
@@ -15,7 +14,7 @@
15 21<div style="display: inline-block; width: 13px;"></div>55<div style="display: inline-block; width: 13px;"></div>43
14 21<div style="display: inline-block; width: 13px;"></div>55<div style="display: inline-block; width: 13px;"></div>43
16 </div>
15 </div>
17 </div>
16 </div>
18− <div align="center" style="margin-top: 233px;">
17+ <div style="text-align: center; margin-top: 233px;">
19 <a href="#" style="text-decoration: underline; font-family: sans-serif; color: #555;font-size: 13px; margin-bottom: 21px;">Revoke access</a>
18 <a href="#" style="text-decoration: underline; font-family: sans-serif; color: #555;font-size: 13px; margin-bottom: 21px;">Revoke access</a>
20 </div>
19 </div>
21</body>
20</body>
denis/package.yaml+17−6
@@ -27,12 +27,9 @@ dependencies:
27- text
27- text
28- aeson
28- aeson
29- bytestring
29- bytestring
30−# - http-client
31−# - http-client-tls
32- servant-websockets
30- servant-websockets
33- websockets
31- websockets
34- squeal-postgresql
32- squeal-postgresql
35−# - transformers-base
36- monad-control
33- monad-control
37- generics-sop
34- generics-sop
38- containers
35- containers
@@ -61,10 +58,15 @@ dependencies:
61- regex-compat
58- regex-compat
62- smtp-mail
59- smtp-mail
63- mime-mail
60- mime-mail
64−- periodic
65- ua-parser
61- ua-parser
66−
62+- cryptohash-sha512
67−
63+- blaze-html
64+- servant-blaze
65+- random
66+- hspec
67+- generic-arbitrary
68+- quickcheck-instances
69+- http-client
68
70
69library:
71library:
70 source-dirs: src
72 source-dirs: src
@@ -107,4 +109,13 @@ executables:
107 - -rtsopts
109 - -rtsopts
108 - -with-rtsopts=-N
110 - -with-rtsopts=-N
109 dependencies:
111 dependencies:
112+ - denis
113+ test:
114+ main: Spec.hs
115+ source-dirs: src/test
116+ ghc-options:
117+ - -threaded
118+ dependencies:
119+ - QuickCheck
120+ - servant-quickcheck
110 - denis
121 - denis
denis/src/Data/Channel/AnonymousChannel.hs+13−7
@@ -5,7 +5,8 @@
5 OverloadedStrings ,
5 OverloadedStrings ,
6 TypeApplications ,
6 TypeApplications ,
7 TypeOperators,
7 TypeOperators,
8− OverloadedStrings #-}
8+ OverloadedStrings,
9+ RecordWildCards #-}
9
10
10module Data.Channel.AnonymousChannel (
11module Data.Channel.AnonymousChannel (
11 AnonymousChannelId,
12 AnonymousChannelId,
@@ -19,15 +20,20 @@ import Data.Aeson
19import Servant.Docs (ToSample, toSamples, samples)
20import Servant.Docs (ToSample, toSamples, samples)
20import Data.Text (Text)
21import Data.Text (Text)
21import qualified Data.Vector as V
22import qualified Data.Vector as V
22−import Data.User
23+import Data.User
23import qualified Data.Set as Set
24import qualified Data.Set as Set
24−
25+import Data.Tags.Validation
26+import Data.Text.Validator
25
27
26-- MARK: Documentation
28-- MARK: Documentation
27
29
28instance ToSample AnonymousChannel where
30instance ToSample AnonymousChannel where
29 toSamples _ = samples $ AnonymousChannel <$> [V.fromList ["thisIsHashTag", "thisIsAlsoHashTag"]] <*> [[2, 7, 8]]
31 toSamples _ = samples $ AnonymousChannel <$> [V.fromList ["thisIsHashTag", "thisIsAlsoHashTag"]] <*> [[2, 7, 8]]
30−
32+
33+
34+instance HasValidatableText AnonymousChannel where
35+ validateText AnonymousChannel{..} = all (validateText . (~= validateTag')) anonymousChannelTags
36+
31-- MARK: Implementation
37-- MARK: Implementation
32
38
33type AnonymousChannelId = Int64
39type AnonymousChannelId = Int64
@@ -46,10 +52,10 @@ instance ToJSON AnonymousChannel where
46 "people" .= cPeople ]
52 "people" .= cPeople ]
47
53
48instance FromJSON AnonymousChannel where
54instance FromJSON AnonymousChannel where
49− parseJSON = withObject "anonymous channel" $ \e ->
55+ parseJSON = withObject "anonymous channel" $ \e ->
50 AnonymousChannel <$> fmap (V.fromList . removeDuplicates) (e .: "tags") <*> fmap removeDuplicates (e .: "people")
56 AnonymousChannel <$> fmap (V.fromList . removeDuplicates) (e .: "tags") <*> fmap removeDuplicates (e .: "people")
51− where
57+ where
52 removeDuplicates :: Ord a => [a] -> [a]
58 removeDuplicates :: Ord a => [a] -> [a]
53 removeDuplicates = Set.toList . Set.fromList
59 removeDuplicates = Set.toList . Set.fromList
54
60
55−
61+
denis/src/Data/Channel/NamedChannel.hs+20−11
@@ -5,7 +5,8 @@ OverloadedLabels,
5OverloadedStrings ,
5OverloadedStrings ,
6TypeApplications ,
6TypeApplications ,
7TypeOperators,
7TypeOperators,
8−OverloadedStrings #-}
8+OverloadedStrings,
9+RecordWildCards #-}
9
10
10module Data.Channel.NamedChannel (
11module Data.Channel.NamedChannel (
11 NamedChannelId,
12 NamedChannelId,
@@ -21,18 +22,26 @@ import Servant.Docs (ToSample, toSamples, samples)
21import Data.Proxy
22import Data.Proxy
22import Data.Text (Text)
23import Data.Text (Text)
23import qualified Data.Vector as V
24import qualified Data.Vector as V
24−import Data.User
25+import Data.User
25import qualified Data.Set as Set
26import qualified Data.Set as Set
27+import Data.Text.Validator
28+import Data.Tags.Validation
29+import Data.Limits
26
30
27-- MARK: Documentation
31-- MARK: Documentation
28
32
29instance (ToSample u) => ToSample (NamedChannel u) where
33instance (ToSample u) => ToSample (NamedChannel u) where
30 toSamples _ = samples $ NamedChannel <$> [8] <*> ["социология", "ФКН"] <*> [V.fromList ["thisIsHashTag", "thisIsAlsoHashTag"]] <*> [V.fromList (map snd $ toSamples Proxy)]
34 toSamples _ = samples $ NamedChannel <$> [8] <*> ["социология", "ФКН"] <*> [V.fromList ["thisIsHashTag", "thisIsAlsoHashTag"]] <*> [V.fromList (map snd $ toSamples Proxy)]
31
35
32−
33instance ToSample NamedChannelCreationRequest where
36instance ToSample NamedChannelCreationRequest where
34 toSamples _ = samples $ NamedChannelCreationRequest <$> ["социология", "ФКН"] <*> [V.fromList ["thisIsHashTag", "thisIsAlsoHashTag"]] <*> [V.fromList [2, 7, 8]]
37 toSamples _ = samples $ NamedChannelCreationRequest <$> ["социология", "ФКН"] <*> [V.fromList ["thisIsHashTag", "thisIsAlsoHashTag"]] <*> [V.fromList [2, 7, 8]]
35−
38+
39+instance HasValidatableText (NamedChannel u) where
40+ validateText NamedChannel{..} = validateText (namedChannelName ~< maxChannelName) && all (validateText . (~= validateTag')) namedChannelTags
41+
42+instance HasValidatableText (NamedChannelCreationRequest) where
43+ validateText NamedChannelCreationRequest{..} = validateText (namedChannelCreationRequestName ~< maxChannelName) && all validateText namedChannelCreationRequestTags
44+
36-- MARK: Implementation
45-- MARK: Implementation
37
46
38type NamedChannelId = Int64
47type NamedChannelId = Int64
@@ -53,14 +62,14 @@ instance (ToJSON u) => ToJSON (NamedChannel u) where
53 "people" .= cPeople ]
62 "people" .= cPeople ]
54
63
55instance (FromJSON u, Ord u) => FromJSON (NamedChannel u) where
64instance (FromJSON u, Ord u) => FromJSON (NamedChannel u) where
56− parseJSON = withObject "named channel" $ \e ->
65+ parseJSON = withObject "named channel" $ \e ->
57 NamedChannel <$> e .: "id" <*> e .: "name" <*> fmap removeDuplicates (e .: "tags") <*> fmap removeDuplicates (e .: "people")
66 NamedChannel <$> e .: "id" <*> e .: "name" <*> fmap removeDuplicates (e .: "tags") <*> fmap removeDuplicates (e .: "people")
58− where
67+ where
59 removeDuplicates :: Ord a => [a] -> V.Vector a
68 removeDuplicates :: Ord a => [a] -> V.Vector a
60 removeDuplicates = V.fromList . Set.toList . Set.fromList
69 removeDuplicates = V.fromList . Set.toList . Set.fromList
61−
70+
62-- MARK: NamedChannelCreationRequest
71-- MARK: NamedChannelCreationRequest
63−
72+
64data NamedChannelCreationRequest = NamedChannelCreationRequest {
73data NamedChannelCreationRequest = NamedChannelCreationRequest {
65 namedChannelCreationRequestName :: Text,
74 namedChannelCreationRequestName :: Text,
66 namedChannelCreationRequestTags :: V.Vector Text,
75 namedChannelCreationRequestTags :: V.Vector Text,
@@ -75,10 +84,10 @@ instance ToJSON NamedChannelCreationRequest where
75 "name" .= cName,
84 "name" .= cName,
76 "tags" .= cTags,
85 "tags" .= cTags,
77 "people" .= cPeople ]
86 "people" .= cPeople ]
78−
87+
79instance FromJSON NamedChannelCreationRequest where
88instance FromJSON NamedChannelCreationRequest where
80− parseJSON = withObject "named channel" $ \e ->
89+ parseJSON = withObject "named channel" $ \e ->
81 NamedChannelCreationRequest <$> e .: "name" <*> fmap removeDuplicates (e .: "tags") <*> fmap removeDuplicates (e .: "people")
90 NamedChannelCreationRequest <$> e .: "name" <*> fmap removeDuplicates (e .: "tags") <*> fmap removeDuplicates (e .: "people")
82− where
91+ where
83 removeDuplicates :: Ord a => [a] -> V.Vector a
92 removeDuplicates :: Ord a => [a] -> V.Vector a
84 removeDuplicates = V.fromList . Set.toList . Set.fromList
93 removeDuplicates = V.fromList . Set.toList . Set.fromList
denis/src/Data/Connection.hs+6−1
@@ -32,9 +32,14 @@ import Control.Monad.Trans.Control
32
32
33type StaticPQ = PoolPQ Schema Handler
33type StaticPQ = PoolPQ Schema Handler
34
34
35+printRed :: (Show a) => a -> IO ()
36+printRed a = do
37+ putStr "\a\x001b[31m"
38+ print a
39+ putStr "\x001b[0m"
35
40
36runQ :: ServantErr -> StaticPQ a -> App a
41runQ :: ServantErr -> StaticPQ a -> App a
37−runQ err req = handleSqueal ((>> throwError err) . liftIO . print) $ asks getPool >>= lift . runPoolPQ req
42+runQ err req = handleSqueal ((>> throwError err) . liftIO . printRed) $ asks getPool >>= lift . runPoolPQ req
38
43
39runQ' :: DBConnection -> ServantErr -> StaticPQ a -> Handler a
44runQ' :: DBConnection -> ServantErr -> StaticPQ a -> Handler a
40runQ' conn err req = handleSqueal (const $ throwError err) $ runPoolPQ req conn
45runQ' conn err req = handleSqueal (const $ throwError err) $ runPoolPQ req conn
denis/src/Data/Faculty.hs+9−6
@@ -21,8 +21,8 @@ import qualified Data.Vector as V
21import Servant.Docs
21import Servant.Docs
22
22
23instance ToSample Faculty where
23instance ToSample Faculty where
24− toSamples _ = singleSample $ Faculty "name" "cs.hse.ru/bse" "ФКН -> ПИ" "Москва" "193729"
24+ toSamples _ = singleSample $ Faculty "ПИ" "cs.hse.ru/bse" "ФКН -> ПИ" "Москва" "193729"
25− (V.fromList ["Программирование", "Естсественные науки"])
25+ (V.fromList ["Программирование", "Естсественные науки"]) "Настоящий адрес факультета"
26
26
27type FacultyUrl = T.Text
27type FacultyUrl = T.Text
28
28
@@ -32,17 +32,19 @@ data Faculty = Faculty {
32 facultyPath :: T.Text,
32 facultyPath :: T.Text,
33 facultyCampusName :: T.Text,
33 facultyCampusName :: T.Text,
34 facultyCampusCode :: T.Text,
34 facultyCampusCode :: T.Text,
35− facultyTags :: V.Vector T.Text
35+ facultyTags :: V.Vector T.Text,
36+ facultyAddress :: T.Text
36} deriving (GHC.Generic, Show, SOP.Generic, SOP.HasDatatypeInfo)
37} deriving (GHC.Generic, Show, SOP.Generic, SOP.HasDatatypeInfo)
37
38
38instance ToJSON Faculty where
39instance ToJSON Faculty where
39− toJSON (Faculty name url p campusName campusCode tags) = object [
40+ toJSON (Faculty name url p campusName campusCode tags address) = object [
40 "name" .= name,
41 "name" .= name,
41 "url" .= url,
42 "url" .= url,
42 "path" .= p,
43 "path" .= p,
43 "campusName" .= campusName,
44 "campusName" .= campusName,
44 "campusCode" .= campusCode,
45 "campusCode" .= campusCode,
45− "tags" .= tags
46+ "tags" .= tags,
47+ "address" .= address
46 ]
48 ]
47
49
48instance FromJSON Faculty where
50instance FromJSON Faculty where
@@ -53,4 +55,5 @@ instance FromJSON Faculty where
53 e .: "path" <*>
55 e .: "path" <*>
54 e .: "campusName" <*>
56 e .: "campusName" <*>
55 e .: "campusCode" <*>
57 e .: "campusCode" <*>
56− e .: "tags"
58+ e .: "tags" <*>
59+ e .: "address"
denis/src/Data/Faculty/Parser.hs+2−1
@@ -64,7 +64,8 @@ getFacultiesForCampus (Campus cName cCode) = do
64 else Just ()
64 else Just ()
65 let tags = map (T.strip . snd) . texts' mempty . map (NodeElement) . filter (classIs "with-indent small tag-set") $ els
65 let tags = map (T.strip . snd) . texts' mempty . map (NodeElement) . filter (classIs "with-indent small tag-set") $ els
66 let path = T.unwords . map (T.strip . snd) . texts' mempty . map (NodeElement) . filter (classIs "small") $ els
66 let path = T.unwords . map (T.strip . snd) . texts' mempty . map (NodeElement) . filter (classIs "small") $ els
67+ let address = T.unwords . map (T.strip . snd) . texts' mempty . map (NodeElement) . filter (classIs "link link_dark i") $ els
67− return $ Faculty name url path cName cCode (V.fromList tags)
68+ return $ Faculty name url path cName cCode (V.fromList tags) address
68
69
69classIs :: T.Text -> Element -> Bool
70classIs :: T.Text -> Element -> Bool
70classIs c = (== (Just c)) . HM.lookup "class" . eltAttrs
71classIs c = (== (Just c)) . HM.lookup "class" . eltAttrs
denis/src/Data/GroupChat.hs+10−1
@@ -7,7 +7,8 @@
7 TypeOperators,
7 TypeOperators,
8 OverloadedStrings,
8 OverloadedStrings,
9 TypeSynonymInstances,
9 TypeSynonymInstances,
10− FlexibleInstances #-}
10+ FlexibleInstances,
11+ RecordWildCards #-}
11{-# OPTIONS_GHC -Wno-orphans #-}
12{-# OPTIONS_GHC -Wno-orphans #-}
12
13
13
14
@@ -32,6 +33,8 @@ import Squeal.PostgreSQL.Schema
32import Data.Function
33import Data.Function
33import Data.Proxy
34import Data.Proxy
34import Servant.Docs
35import Servant.Docs
36+import Data.Limits
37+import Data.Text.Validator
35
38
36instance ToSample GroupChat where
39instance ToSample GroupChat where
37 toSamples _ = samples $ GroupChat <$>
40 toSamples _ = samples $ GroupChat <$>
@@ -44,6 +47,12 @@ instance ToSample GroupChatCreation where
44 (Jsonb <$> map snd (toSamples Proxy)) <*>
47 (Jsonb <$> map snd (toSamples Proxy)) <*>
45 ["cocos", "kursach"]
48 ["cocos", "kursach"]
46
49
50+instance HasValidatableText GroupChat where
51+ validateText GroupChat{..} = validateText $ groupChatName ~< maxGroupChatName
52+
53+instance HasValidatableText GroupChatCreation where
54+ validateText GroupChatCreation{..} = validateText $ groupChatCreationName ~< maxGroupChatName
55+
47instance ToSample UserPermissions where
56instance ToSample UserPermissions where
48 toSamples _ = singleSample $ M.fromList [(69, GroupChatPermissions True), (5051, GroupChatPermissions False)]
57 toSamples _ = singleSample $ M.fromList [(69, GroupChatPermissions True), (5051, GroupChatPermissions False)]
49
58
denis/src/Data/Limits.hsnew file+35
@@ -0,0 +1,35 @@
1+{-# OPTIONS_GHC -Wno-missing-export-lists #-}
2+
3+module Data.Limits where
4+
5+import Data.Int (Int64)
6+
7+maxChannelName :: Int
8+maxChannelName = 60
9+
10+maxGroupChatName :: Int
11+maxGroupChatName = 60
12+
13+maxMessageLimitName :: Int
14+maxMessageLimitName = 60
15+
16+postElementLengthLimit :: Int
17+postElementLengthLimit = 35000
18+
19+userFieldLengthLimit :: Int
20+userFieldLengthLimit = 50
21+
22+maxNumberOfTags :: Int
23+maxNumberOfTags = 20
24+
25+channelCountLimit :: Int64
26+channelCountLimit = 128
27+
28+listLimit :: Int
29+listLimit = 100
30+
31+globalTextLimit :: Int
32+globalTextLimit = 50000
33+
34+groupChatSizeLimit :: Int
35+groupChatSizeLimit = 256
denis/src/Data/Message.hs+15−6
@@ -6,7 +6,8 @@
6 TypeApplications ,
6 TypeApplications ,
7 TypeOperators,
7 TypeOperators,
8 OverloadedStrings,
8 OverloadedStrings,
9− TupleSections #-}
9+ TupleSections,
10+ RecordWildCards #-}
10{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
11{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
11
12
12
13
@@ -33,6 +34,7 @@ import Control.Applicative
33import Data.Aeson.Types
34import Data.Aeson.Types
34import Data.Proxy
35import Data.Proxy
35import Servant.Docs
36import Servant.Docs
37+import Data.Text.Validator
36
38
37instance ToSample Message where
39instance ToSample Message where
38 toSamples _ = samples $ Message 8 69 <$>
40 toSamples _ = samples $ Message 8 69 <$>
@@ -43,6 +45,12 @@ instance ToSample Message where
43instance ToSample MessageDetination where
45instance ToSample MessageDetination where
44 toSamples _ = samples $ [GroupChatDestination 5, UserChatDestination 69]
46 toSamples _ = samples $ [GroupChatDestination 5, UserChatDestination 69]
45
47
48+instance HasValidatableText Message where
49+ validateText Message{..} = validateText messageBody
50+
51+instance HasValidatableText MessageCreation where
52+ validateText (MessageCreation _ _ (Jsonb mb)) = validateText mb
53+
46type GroupChatMessageId = Int64
54type GroupChatMessageId = Int64
47
55
48data MessageDetination = GroupChatDestination GroupChatId | UserChatDestination UserId
56data MessageDetination = GroupChatDestination GroupChatId | UserChatDestination UserId
@@ -81,10 +89,10 @@ instance FromJSON Message where
81
89
82data MessageStorage = MessageStorage {
90data MessageStorage = MessageStorage {
83 messageStorageId :: MessageId,
91 messageStorageId :: MessageId,
84− messageStorageAuthorId :: UserId,
92+ messageStorageAuthorId :: Maybe UserId,
85 messageStorageDestinationGroupId :: Maybe GroupChatId,
93 messageStorageDestinationGroupId :: Maybe GroupChatId,
86 messageStorageDestinationUserId :: Maybe UserId,
94 messageStorageDestinationUserId :: Maybe UserId,
87− messageStorageBody :: Jsonb (PostElement Message),
95+ messageStorageBody :: Maybe (Jsonb (PostElement Message)),
88 messageStorageTime :: UTCTime
96 messageStorageTime :: UTCTime
89} deriving GHC.Generic
97} deriving GHC.Generic
90
98
@@ -97,17 +105,18 @@ infixl 4 <>>
97f <>> a = f <*> pure a
105f <>> a = f <*> pure a
98
106
99restoreMessage :: MessageStorage -> Maybe Message
107restoreMessage :: MessageStorage -> Maybe Message
100−restoreMessage (MessageStorage mId aId gId uId (Jsonb pb) mt) =
108+restoreMessage (MessageStorage mId (Just aId) gId uId (Just (Jsonb pb)) mt) =
101 Message mId aId <$> case (gId, uId) of
109 Message mId aId <$> case (gId, uId) of
102 (Just gId', Nothing) -> Just $ GroupChatDestination gId'
110 (Just gId', Nothing) -> Just $ GroupChatDestination gId'
103 (Nothing, Just uId') -> Just $ UserChatDestination uId'
111 (Nothing, Just uId') -> Just $ UserChatDestination uId'
104 _ -> Nothing
112 _ -> Nothing
105 <>> pb <>> mt
113 <>> pb <>> mt
114+restoreMessage _ = Nothing
106
115
107storeMessage :: Message -> MessageStorage
116storeMessage :: Message -> MessageStorage
108storeMessage (Message mId aId dId pb mt) = case dId of
117storeMessage (Message mId aId dId pb mt) = case dId of
109− GroupChatDestination gId -> MessageStorage mId aId (Just gId) Nothing (Jsonb pb) mt
118+ GroupChatDestination gId -> MessageStorage mId (Just aId) (Just gId) Nothing (Just (Jsonb pb)) mt
110− UserChatDestination uId -> MessageStorage mId aId Nothing (Just uId) (Jsonb pb) mt
119+ UserChatDestination uId -> MessageStorage mId (Just aId) Nothing (Just uId) (Just (Jsonb pb)) mt
111
120
112instance ToSample MessageCreation where
121instance ToSample MessageCreation where
113 toSamples _ = samples $ (MessageCreation Nothing (Just 69) <$>
122 toSamples _ = samples $ (MessageCreation Nothing (Just 69) <$>
denis/src/Data/Post.hs+4
@@ -29,6 +29,8 @@ 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.Tags.Validation
33+import Data.Text.Validator
32
34
33-- MARK: Documentation
35-- MARK: Documentation
34
36
@@ -39,6 +41,8 @@ instance ToSample Post where
39instance ToSample PostCreation where
41instance ToSample PostCreation where
40 toSamples _ = samples $ PostCreation <$> (map snd $ toSamples Proxy) <*> [(V.fromList ["hse", "cs", "machineLearning"])]
42 toSamples _ = samples $ PostCreation <$> (map snd $ toSamples Proxy) <*> [(V.fromList ["hse", "cs", "machineLearning"])]
41
43
44+instance HasValidatableText PostCreation where
45+ validateText (PostCreation body tags) = all validateText body && all (validateText . (~= validateTag')) tags
42
46
43-- MARK: Actual type
47-- MARK: Actual type
44
48
denis/src/Data/PostElement.hs+23−6
@@ -15,16 +15,20 @@ module Data.PostElement (
15 MkElementRow,
15 MkElementRow,
16 PostElementRow(..),
16 PostElementRow(..),
17 PostElement(..),
17 PostElement(..),
18− elementsToRows
18+ elementsToRows,
19+ PostQuote(..),
20+ stripPostElement
19) where
21) where
20
22
21import Data.Int (Int64)
23import Data.Int (Int64)
22import qualified Generics.SOP as SOP
24import qualified Generics.SOP as SOP
23import qualified GHC.Generics as GHC
25import qualified GHC.Generics as GHC
24−import Data.Text (Text)
26+import Data.Text (Text, strip)
25import Data.Aeson
27import Data.Aeson
26import Control.Applicative ((<|>))
28import Control.Applicative ((<|>))
27import Servant.Docs (ToSample, toSamples, samples)
29import Servant.Docs (ToSample, toSamples, samples)
30+import Data.Text.Validator
31+import Data.Limits
28
32
29-- MARK: Documentation
33-- MARK: Documentation
30
34
@@ -34,15 +38,27 @@ instance ToSample (PostElement p) where
34 Markdown "## This is a subtitle\n_hello._"
38 Markdown "## This is a subtitle\n_hello._"
35 ]
39 ]
36
40
41+instance HasValidatableText (PostElement p) where
42+ validateText (Markdown t) = validateText $ t ~< postElementLengthLimit
43+ validateText (Latex t) = validateText $ t ~< postElementLengthLimit
44+ validateText (Image t) = validateText $ t ~< postElementLengthLimit
45+ validateText (Quote _) = False
46+ validateText (Attachment t) = validateText $ t ~< postElementLengthLimit
47+
37
48
38-- MARK: PostElement
49-- MARK: PostElement
39
50
40data PostElement a = Markdown Text
51data PostElement a = Markdown Text
41 | Latex Text
52 | Latex Text
42 | Image Text
53 | Image Text
43− | Quote PostQuote
54+ | Quote ()
44 | Attachment Text
55 | Attachment Text
45− deriving (Show)
56+ deriving (Show, GHC.Generic)
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
46
62
47instance ToJSON (PostElement t) where
63instance ToJSON (PostElement t) where
48 toJSON (Markdown m) = object ["markdown" .= m]
64 toJSON (Markdown m) = object ["markdown" .= m]
@@ -69,7 +85,8 @@ elemenToRow f el = case el of
69 Markdown m -> f (Just m) Nothing Nothing Nothing Nothing
85 Markdown m -> f (Just m) Nothing Nothing Nothing Nothing
70 Latex l -> f Nothing (Just l) Nothing Nothing Nothing
86 Latex l -> f Nothing (Just l) Nothing Nothing Nothing
71 Image i -> f Nothing Nothing (Just i) Nothing Nothing
87 Image i -> f Nothing Nothing (Just i) Nothing Nothing
72− Quote q -> f Nothing Nothing Nothing (Just $ quoteId q) Nothing
88+ -- Quote q -> f Nothing Nothing Nothing (Just $ (quoteId q)) Nothing
89+ Quote _ -> f Nothing Nothing Nothing Nothing Nothing
73 Attachment a -> f Nothing Nothing Nothing Nothing (Just a)
90 Attachment a -> f Nothing Nothing Nothing Nothing (Just a)
74
91
75rowsToElement :: MkElementRow (Maybe (PostElement p))
92rowsToElement :: MkElementRow (Maybe (PostElement p))
@@ -105,7 +122,7 @@ data PostQuote = PostQuote {
105 quoteId :: Int64,
122 quoteId :: Int64,
106 quoteBody :: [PostElement PostQuote],
123 quoteBody :: [PostElement PostQuote],
107 quotePostId :: Int64
124 quotePostId :: Int64
108−} deriving (Show)
125+} deriving (Show, GHC.Generic)
109
126
110instance ToJSON PostQuote where
127instance ToJSON PostQuote where
111 toJSON (PostQuote qId pb pId) = object [
128 toJSON (PostQuote qId pb pId) = object [
denis/src/Data/Query.hs+319−55
@@ -9,7 +9,8 @@
9 FlexibleInstances,
9 FlexibleInstances,
10 KindSignatures,
10 KindSignatures,
11 DeriveAnyClass,
11 DeriveAnyClass,
12− RecordWildCards #-}
12+ RecordWildCards,
13+ ScopedTypeVariables #-}
13
14
14{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
15{-# OPTIONS_GHC -Wno-partial-type-signatures #-}
15
16
@@ -53,7 +54,19 @@ module Data.Query (
53 tryVerifyToken,
54 tryVerifyToken,
54 getVerifiedToken,
55 getVerifiedToken,
55 UserCreation(..),
56 UserCreation(..),
56− createUser
57+ createUser,
58+ tryActivateToken,
59+ deactivateToken,
60+ searchUsers,
61+ searchTags,
62+ updateUser,
63+ UserUpdateRow(..),
64+ killAllTokens,
65+ channelCountForUser,
66+ pruneAuth,
67+ searchChannels,
68+ isValidFaculty,
69+ groupChatIsValidForUser
57 ) where
70 ) where
58
71
59import Squeal.PostgreSQL
72import Squeal.PostgreSQL
@@ -83,7 +96,7 @@ import Data.Text (Text)
83import qualified Data.Text as T
96import qualified Data.Text as T
84import Data.Channel.NamedChannel
97import Data.Channel.NamedChannel
85import Data.Channel.AnonymousChannel
98import Data.Channel.AnonymousChannel
86−import Data.Maybe (fromMaybe)
99+import Data.Maybe (fromMaybe, catMaybes, isJust)
87import Squeal.PostgreSQL.Render
100import Squeal.PostgreSQL.Render
88import Data.GroupChat
101import Data.GroupChat
89import Data.Message
102import Data.Message
@@ -95,7 +108,8 @@ import Data.Foldable (fold)
95import Data.Char
108import Data.Char
96import qualified Data.Vector as V
109import qualified Data.Vector as V
97import Server.Auth.Token
110import Server.Auth.Token
98−import Data.Int
111+import Server.Error
112+import Data.Text.Validator
99
113
100-- MARK: Documentation
114-- MARK: Documentation
101
115
@@ -192,7 +206,8 @@ getUsersQ uIds = case idsToColumn uIds of
192 #faculties ! #facultyPath `as` #userRowFacultyPath :*
206 #faculties ! #facultyPath `as` #userRowFacultyPath :*
193 #faculties ! #facultyCampusName `as` #userRowFacultyCampusName :*
207 #faculties ! #facultyCampusName `as` #userRowFacultyCampusName :*
194 #faculties ! #facultyCampusCode `as` #userRowFacultyCampusCode :*
208 #faculties ! #facultyCampusCode `as` #userRowFacultyCampusCode :*
195− #faculties ! #facultyTags `as` #userRowFacultyTags
209+ #faculties ! #facultyTags `as` #userRowFacultyTags :*
210+ #faculties ! #facultyAddress `as` #userRowFacultyAddress
196 ) (from (subquery (idQ `As` #ids) &
211 ) (from (subquery (idQ `As` #ids) &
197 innerJoin (table #users)
212 innerJoin (table #users)
198 (#ids ! #id .== #users ! #userRowId) &
213 (#ids ! #id .== #users ! #userRowId) &
@@ -215,7 +230,8 @@ getAllUsersQ = select (
215 #faculties ! #facultyPath `as` #userRowFacultyPath :*
230 #faculties ! #facultyPath `as` #userRowFacultyPath :*
216 #faculties ! #facultyCampusName `as` #userRowFacultyCampusName :*
231 #faculties ! #facultyCampusName `as` #userRowFacultyCampusName :*
217 #faculties ! #facultyCampusCode `as` #userRowFacultyCampusCode :*
232 #faculties ! #facultyCampusCode `as` #userRowFacultyCampusCode :*
218− #faculties ! #facultyTags `as` #userRowFacultyTags
233+ #faculties ! #facultyTags `as` #userRowFacultyTags :*
234+ #faculties ! #facultyAddress `as` #userRowFacultyAddress
219 ) (from ((table #users) &
235 ) (from ((table #users) &
220 innerJoin (table #faculties)
236 innerJoin (table #faculties)
221 (#users ! #userRowFacultyUrl .== #faculties ! #facultyUrl))&
237 (#users ! #userRowFacultyUrl .== #faculties ! #facultyUrl))&
@@ -281,12 +297,40 @@ getChannelForUserQ = selectStar $
281 from (table #channels) &
297 from (table #channels) &
282 where_ (#namedChannelFullOwner .== param @1 .&& #namedChannelFullId .== param @2)
298 where_ (#namedChannelFullOwner .== param @1 .&& #namedChannelFullId .== param @2)
283
299
300+updateUserQ :: Manipulation Schema (TuplePG (UserUpdateRow)) (RowPG (Only UserId))
301+updateUserQ = update #users (
302+ Same `as` #userRowId :*
303+ Set (param @2) `as` #userRowFirstName :*
304+ Set (param @3) `as` #userRowMiddleName :*
305+ Set (param @4) `as` #userRowLastName :*
306+ Set (param @5) `as` #userRowFacultyUrl :*
307+ Same `as` #userRowEmail :*
308+ Same `as` #userRowIsValidated)
309+ (#userRowId .== param @1)
310+ (Returning $ #userRowId `as` #fromOnly)
311+
284getAllChannelsForUserQ :: Query Schema (TuplePG (Only UserId)) (RowPG NamedChannelFull)
312getAllChannelsForUserQ :: Query Schema (TuplePG (Only UserId)) (RowPG NamedChannelFull)
285getAllChannelsForUserQ = selectStar $
313getAllChannelsForUserQ = selectStar $
286 from (table #channels) &
314 from (table #channels) &
287 where_ (#namedChannelFullOwner .== param @1) &
315 where_ (#namedChannelFullOwner .== param @1) &
288 orderBy [#namedChannelFullId & Desc]
316 orderBy [#namedChannelFullId & Desc]
289
317
318+searchChannelsForUserQ :: Query Schema (TuplePG (UserId, Text)) (RowPG NamedChannelFull)
319+searchChannelsForUserQ = selectStar $
320+ from (table #channels) &
321+ where_ (#namedChannelFullOwner .== param @1) &
322+ orderBy [
323+ tsRankCd vector1 query & Desc,
324+ tsRankCd vector query & Desc
325+ ]
326+ where
327+ vector = tsVector' (textArrayToText [
328+ #namedChannelFullName,
329+ unsafeFunction "unnest" #namedChannelFullTags
330+ ])
331+ vector1 = tsVector' #namedChannelFullName
332+ query = tsQuery' (param @2)
333+
290updateFacultyQ :: Manipulation Schema (TuplePG Faculty) '[]
334updateFacultyQ :: Manipulation Schema (TuplePG Faculty) '[]
291updateFacultyQ = insertRow #faculties
335updateFacultyQ = insertRow #faculties
292 (
336 (
@@ -295,7 +339,8 @@ updateFacultyQ = insertRow #faculties
295 Set (param @3) `as` #facultyPath :*
339 Set (param @3) `as` #facultyPath :*
296 Set (param @4) `as` #facultyCampusName :*
340 Set (param @4) `as` #facultyCampusName :*
297 Set (param @5) `as` #facultyCampusCode :*
341 Set (param @5) `as` #facultyCampusCode :*
298− Set (param @6) `as` #facultyTags
342+ Set (param @6) `as` #facultyTags :*
343+ Set (param @7) `as` #facultyAddress
299 )
344 )
300 (OnConflictDoNothing)
345 (OnConflictDoNothing)
301 (Returning Nil)
346 (Returning Nil)
@@ -316,6 +361,11 @@ createNamedChannelQ = insertRow #channels
316 OnConflictDoRaise
361 OnConflictDoRaise
317 (Returning $ #namedChannelFullId `as` #fromOnly)
362 (Returning $ #namedChannelFullId `as` #fromOnly)
318
363
364+countChannelsQ :: Query Schema (TuplePG (Only UserId)) (RowPG (Only Int64))
365+countChannelsQ = select (countStar `as` #fromOnly) (from (table #channels) &
366+ where_ (#namedChannelFullOwner .== param @1) &
367+ groupBy #namedChannelFullOwner)
368+
319deleteNamedChannelQ :: Manipulation Schema (TuplePG (Only NamedChannelId)) '[]
369deleteNamedChannelQ :: Manipulation Schema (TuplePG (Only NamedChannelId)) '[]
320deleteNamedChannelQ = deleteFrom_ #channels (#namedChannelFullId .== param @1)
370deleteNamedChannelQ = deleteFrom_ #channels (#namedChannelFullId .== param @1)
321
371
@@ -348,7 +398,7 @@ getChannelPostsQ lim dir uIds tags = getLastPostsQ
348 Just uIdsQ -> (`in_` uIdsQ)
398 Just uIdsQ -> (`in_` uIdsQ)
349 Nothing -> const $ false
399 Nothing -> const $ false
350
400
351−getTagsQ :: Query Schema '[] (RowPG (Only String))
401+getTagsQ :: Query Schema params (RowPG (Only String))
352getTagsQ = selectDistinct (unsafeFunction "unnest" #postRowTags `as` #fromOnly) $
402getTagsQ = selectDistinct (unsafeFunction "unnest" #postRowTags `as` #fromOnly) $
353 from (table #posts)
403 from (table #posts)
354
404
@@ -359,15 +409,26 @@ createMessageQ :: Manipulation
359createMessageQ = insertRow #messages
409createMessageQ = insertRow #messages
360 (
410 (
361 Default `as` #messageStorageId :*
411 Default `as` #messageStorageId :*
362− Set (param @1) `as` #messageStorageAuthorId :*
412+ Set (notNull $ param @1) `as` #messageStorageAuthorId :*
363 Set (param @2) `as` #messageStorageDestinationGroupId :*
413 Set (param @2) `as` #messageStorageDestinationGroupId :*
364 Set (param @3) `as` #messageStorageDestinationUserId :*
414 Set (param @3) `as` #messageStorageDestinationUserId :*
365− Set (param @4) `as` #messageStorageBody :*
415+ Set (notNull $ param @4) `as` #messageStorageBody :*
366 Set currentTimestamp `as` #messageStorageTime
416 Set currentTimestamp `as` #messageStorageTime
367 )
417 )
368 OnConflictDoRaise
418 OnConflictDoRaise
369 (Returning $ #messageStorageId `as` #fromOnly)
419 (Returning $ #messageStorageId `as` #fromOnly)
370
420
421+createPhantomMessageQ :: Manipulation Schema (TuplePG (Only GroupChatId)) '[]
422+createPhantomMessageQ = insertRow_ #messages
423+ (
424+ Default `as` #messageStorageId :*
425+ Set null_ `as` #messageStorageAuthorId :*
426+ Set (notNull $ param @1) `as` #messageStorageDestinationGroupId :*
427+ Set null_ `as` #messageStorageDestinationUserId :*
428+ Set null_ `as` #messageStorageBody :*
429+ Set currentTimestamp `as` #messageStorageTime
430+ )
431+
371createGroupChatQ :: Manipulation Schema (TuplePG GroupChatCreation) (RowPG (Only GroupChatId))
432createGroupChatQ :: Manipulation Schema (TuplePG GroupChatCreation) (RowPG (Only GroupChatId))
372createGroupChatQ = insertRow #groupChats
433createGroupChatQ = insertRow #groupChats
373 (
434 (
@@ -443,7 +504,7 @@ getChatsQ lim dir = select (
443 (ifThenElse
504 (ifThenElse
444 (#messageStorageAuthorId .== param @1)
505 (#messageStorageAuthorId .== param @1)
445 #messageStorageDestinationUserId
506 #messageStorageDestinationUserId
446− (notNull #messageStorageAuthorId)) `as` #messageUserId) $
507+ #messageStorageAuthorId) `as` #messageUserId) $
447 from (table #messages) &
508 from (table #messages) &
448 where_ (isNotNull #messageStorageDestinationUserId .&&
509 where_ (isNotNull #messageStorageDestinationUserId .&&
449 (#messageStorageAuthorId .== param @1 .||
510 (#messageStorageAuthorId .== param @1 .||
@@ -510,21 +571,83 @@ getGroupChatForUserQ = selectStar $
510getFacultySearchResultQ :: Query Schema (TuplePG (Only Text)) (RowPG Faculty)
571getFacultySearchResultQ :: Query Schema (TuplePG (Only Text)) (RowPG Faculty)
511getFacultySearchResultQ = selectStar (from (table #faculties) &
572getFacultySearchResultQ = selectStar (from (table #faculties) &
512 where_ (vector @@ query) &
573 where_ (vector @@ query) &
574+ orderBy [
575+ tsRankCd vector1 query & Desc,
576+ tsRankCd vector2 query & Desc,
513− orderBy [tsRankCd vector query & Desc])
577+ tsRankCd vector query & Desc
578+ ])
514 where
579 where
515 vector = tsVector "russian" (textArrayToText [
580 vector = tsVector "russian" (textArrayToText [
516 #facultyName,
581 #facultyName,
517 #facultyPath,
582 #facultyPath,
518 #facultyCampusName,
583 #facultyCampusName,
519 (arrayToText #facultyTags)])
584 (arrayToText #facultyTags)])
585+ vector1 = tsVector "russian" #facultyName
586+ vector2 = tsVector "russian" (textArrayToText [
587+ #facultyName,
588+ #facultyPath])
520 query = tsQuery "russian" (param @1)
589 query = tsQuery "russian" (param @1)
521
590
591+searchUsersQ :: Query Schema (TuplePG (Only Text)) (RowPG UserRow)
592+searchUsersQ = select (
593+ #users ! #userRowId :*
594+ #users ! #userRowFirstName :*
595+ #users ! #userRowMiddleName :*
596+ #users ! #userRowLastName :*
597+ #users ! #userRowFacultyUrl :*
598+ #users ! #userRowEmail :*
599+ #users ! #userRowIsValidated :*
600+ #faculties ! #facultyName `as` #userRowFacultyName :*
601+ #faculties ! #facultyUrl `as` #userRowFacultyURL :*
602+ #faculties ! #facultyPath `as` #userRowFacultyPath :*
603+ #faculties ! #facultyCampusName `as` #userRowFacultyCampusName :*
604+ #faculties ! #facultyCampusCode `as` #userRowFacultyCampusCode :*
605+ #faculties ! #facultyTags `as` #userRowFacultyTags :*
606+ #faculties ! #facultyAddress `as` #userRowFacultyAddress
607+ ) (from ((table #users) &
608+ innerJoin (table #faculties)
609+ (#users ! #userRowFacultyUrl .== #faculties ! #facultyUrl)) &
610+ where_ (notNull $ #users ! #userRowIsValidated) &
611+ where_ (vector @@ query) &
612+ orderBy [tsRankCd vector query & Desc] &
613+ limit 100)
614+ where
615+ vector = tsVector' (textArrayToText [
616+ #users ! #userRowFirstName,
617+ #users ! #userRowMiddleName,
618+ #users ! #userRowLastName
619+ ])
620+ query = tsQuery' (param @1)
621+
622+tagsByFrquencyQ :: Query Schema params '["tag" ::: 'NotNull (PG Text), "count" ::: 'NotNull 'PGint8]
623+tagsByFrquencyQ = select
624+ (#fromOnly `as` #tag :* count #fromOnly `as` #count)
625+ (from (subquery $ getTagsQ `As` #tt) &
626+ groupBy #fromOnly)
627+
628+getNpopularTagsQ :: Limit -> Query Schema param (RowPG (Only Text))
629+getNpopularTagsQ lim = select (#tag `as` #fromOnly)
630+ (from (subquery $ tagsByFrquencyQ `As` #tt) &
631+ orderBy [#count & Desc] &
632+ limit lim)
633+
634+
635+searchTagsQ :: Query Schema (TuplePG (Only Text)) (RowPG (Only Text))
636+searchTagsQ = select (#tag `as` #fromOnly) $
637+ from (subquery (tagsByFrquencyQ `As` #tt)) &
638+ where_ (vector @@ query) &
639+ orderBy [#count & Desc] &
640+ limit 100
641+ where
642+ query = tsQuery' (param @1)
643+ vector = tsVector' #tag
644+
522tsRankCd
645tsRankCd
523 :: Expression schema from grouping params ('NotNull 'PGtext)
646 :: Expression schema from grouping params ('NotNull 'PGtext)
524 -> Expression schema from grouping params ('NotNull 'PGtext)
647 -> Expression schema from grouping params ('NotNull 'PGtext)
525 -> Expression schema from grouping params ('NotNull 'PGfloat4)
648 -> Expression schema from grouping params ('NotNull 'PGfloat4)
526tsRankCd vector query = UnsafeExpression $
649tsRankCd vector query = UnsafeExpression $
527− "ts_rank_cd" <> parenthesized (commaSeparated . map renderExpression $ [vector, query])
650+ "ts_rank_cd" <> parenthesized (commaSeparated ["ARRAY[1,1,1,1]", renderExpression vector, renderExpression query, "2|4|8|16|32"])
528
651
529tsVector
652tsVector
530 :: ByteString -- ^ Language
653 :: ByteString -- ^ Language
@@ -533,6 +656,12 @@ tsVector
533tsVector lang x = UnsafeExpression $
656tsVector lang x = UnsafeExpression $
534 "to_tsvector" <> parenthesized (commaSeparated [singleQuotedUtf8 lang, renderExpression x])
657 "to_tsvector" <> parenthesized (commaSeparated [singleQuotedUtf8 lang, renderExpression x])
535
658
659+tsVector'
660+ :: Expression schema from grouping params ('NotNull 'PGtext)
661+ -> Expression schema from grouping params ('NotNull 'PGtext)
662+tsVector' x = UnsafeExpression $
663+ "to_tsvector" <> parenthesized (renderExpression x)
664+
536tsQuery
665tsQuery
537 :: ByteString -- ^ Language
666 :: ByteString -- ^ Language
538 -> Expression schema from grouping params ('NotNull 'PGtext)
667 -> Expression schema from grouping params ('NotNull 'PGtext)
@@ -540,6 +669,12 @@ tsQuery
540tsQuery lang x = UnsafeExpression $
669tsQuery lang x = UnsafeExpression $
541 "to_tsquery" <> parenthesized (commaSeparated [singleQuotedUtf8 lang, renderExpression x])
670 "to_tsquery" <> parenthesized (commaSeparated [singleQuotedUtf8 lang, renderExpression x])
542
671
672+tsQuery'
673+ :: Expression schema from grouping params ('NotNull 'PGtext)
674+ -> Expression schema from grouping params ('NotNull 'PGtext)
675+tsQuery' x = UnsafeExpression $
676+ "to_tsquery" <> parenthesized (renderExpression x)
677+
543arrayToText
678arrayToText
544 :: Expression schema from grouping params ('NotNull ('PGvararray ('NotNull 'PGtext)))
679 :: Expression schema from grouping params ('NotNull ('PGvararray ('NotNull 'PGtext)))
545 -> Expression schema from grouping params ('NotNull 'PGtext)
680 -> Expression schema from grouping params ('NotNull 'PGtext)
@@ -622,14 +757,47 @@ getTokenQ = selectStar (from (table #tokens) &
622 where_ (#tokenUserId .== param @1 .&&
757 where_ (#tokenUserId .== param @1 .&&
623 #tokenValue .== param @2))
758 #tokenValue .== param @2))
624
759
760+getTokenActivationQ :: Query Schema (TuplePG (UserId, ByteString)) (RowPG Token)
761+getTokenActivationQ = selectStar (from (table #tokens) &
762+ where_ (#tokenUserId .== param @1 .&&
763+ #tokenActivationCode .== param @2))
764+
765+deactivateTokenQ :: Manipulation Schema (TuplePG (UserId, ByteString)) (RowPG (Only Text))
766+deactivateTokenQ = deleteFrom #tokens
767+ (#tokenUserId .== param @1 .&&
768+ #tokenDeactivationCode .== param @2)
769+ (Returning (#tokenUserAgent `as` #fromOnly))
770+
625getVerifiedTokenQ :: Query Schema (TuplePG (UserId, ByteString)) (RowPG Token)
771getVerifiedTokenQ :: Query Schema (TuplePG (UserId, ByteString)) (RowPG Token)
626getVerifiedTokenQ = selectStar (from (table #tokens) &
772getVerifiedTokenQ = selectStar (from (table #tokens) &
627 where_ (#tokenUserId .== param @1 .&&
773 where_ (#tokenUserId .== param @1 .&&
628 #tokenValue .== param @2 .&&
774 #tokenValue .== param @2 .&&
629− isNull #tokenVerificationCode))
775+ isNull #tokenVerificationCode .&&
776+ currentTimestamp .< #tokenExpiryDate))
777+
778+killAllTokensQ :: Manipulation Schema (TuplePG (Only UserId)) '[]
779+killAllTokensQ = deleteFrom_ #tokens
780+ (#tokenUserId .== param @1)
781+
782+pruneDeadTokensQ :: Manipulation Schema '[] '[]
783+pruneDeadTokensQ = deleteFrom_ #tokens
784+ (#tokenExpiryDate .< currentTimestamp)
785+
786+pruneGhostUsersQ :: Manipulation Schema '[] '[]
787+pruneGhostUsersQ = deleteFrom_ #users
788+ ((not_ . in_ #userRowId $ select (#tokens ! #tokenUserId `as` #id) (from $ table #tokens)) .&&
789+ (not_ . notNull $ #userRowIsValidated))
630
790
631-- MARK: FrontEnd Data Structures
791-- MARK: FrontEnd Data Structures
632
792
793+instance HasValidatableText UserCreation where
794+ validateText UserCreation{..} = all validateText [
795+ userCreationFirstName,
796+ userCreationMiddleName,
797+ userCreationLastName,
798+ userCreationUserFaculty,
799+ userCreationUserEmail]
800+
633data UserCreation = UserCreation {
801data UserCreation = UserCreation {
634 userCreationFirstName :: Text,
802 userCreationFirstName :: Text,
635 userCreationMiddleName :: Text,
803 userCreationMiddleName :: Text,
@@ -648,9 +816,18 @@ instance ToJSON UserCreation where
648 ]
816 ]
649
817
650instance FromJSON UserCreation where
818instance FromJSON UserCreation where
651− parseJSON = withObject "named channel" $ \e ->
819+ parseJSON = withObject "user creation" $ \e ->
652 UserCreation <$> e .: "firstName" <*> e .: "middleName" <*> e .: "lastName" <*> e .: "faculty" <*> e .: "email"
820 UserCreation <$> e .: "firstName" <*> e .: "middleName" <*> e .: "lastName" <*> e .: "faculty" <*> e .: "email"
653
821
822+data UserUpdateRow = UserUpdateRow {
823+ userUpdateRowId :: UserId,
824+ userUpdateRowFirstName :: Text,
825+ userUpdateRowMiddleName :: Text,
826+ userUpdateRowLastName :: Text,
827+ userUpdateRowUserFaculty :: FacultyUrl
828+} deriving (GHC.Generic, SOP.Generic, SOP.HasDatatypeInfo)
829+
830+
654data NamedChannelCreation = NamedChannelCreation {
831data NamedChannelCreation = NamedChannelCreation {
655 namedChannelCreationOwner :: UserId,
832 namedChannelCreationOwner :: UserId,
656 namedChannelCreationName :: Text,
833 namedChannelCreationName :: Text,
@@ -686,11 +863,13 @@ getChannelForUser uId cId = do
686 Nothing -> lift $ S.throwError S.err404
863 Nothing -> lift $ S.throwError S.err404
687
864
688-- TODO: Reject bad requests. Should be binary.
865-- TODO: Reject bad requests. Should be binary.
689−verifiedUsers :: [UserId] -> StaticPQ [UserId]
866+verifyUsers :: [UserId] -> StaticPQ ()
690−verifiedUsers uIds =
867+verifyUsers uIds =
691 case verifiedUserIdsQ uIds of
868 case verifiedUserIdsQ uIds of
869+ Just uIdsQ -> do
692− Just uIdsQ -> fmap fromOnly <$> (runQuery uIdsQ >>= getRows)
870+ (us :: [UserId]) <- fmap fromOnly <$> (runQuery uIdsQ >>= getRows)
871+ when (length us /= length uIds) $ lift $ S.throwError impossibleContent
693− Nothing -> return []
872+ Nothing -> return ()
694
873
695deleteGroupChat :: GroupChatId -> StaticPQ ()
874deleteGroupChat :: GroupChatId -> StaticPQ ()
696deleteGroupChat gId = do
875deleteGroupChat gId = do
@@ -752,30 +931,40 @@ getAllUsers :: StaticPQ [User Faculty]
752getAllUsers = fmap rowToUser <$> (runQuery getAllUsersQ >>= getRows)
931getAllUsers = fmap rowToUser <$> (runQuery getAllUsersQ >>= getRows)
753
932
754publishPost :: UserId -> PostCreation -> StaticPQ PostId
933publishPost :: UserId -> PostCreation -> StaticPQ PostId
755−publishPost uId pc = commitedTransactionallyUpdate $ do
934+publishPost uId pc = commitedTransactionallyUpdate $ do
756 pId' <- manipulateParams createPostRowQ (uId, postCreationTags pc) >>= firstRow
935 pId' <- manipulateParams createPostRowQ (uId, postCreationTags pc) >>= firstRow
757 case pId' of
936 case pId' of
758 (Just (Only pId)) -> do
937 (Just (Only pId)) -> do
759− traversePrepared_ createPostElementRowsQ $ elementsToRows pId (postCreationBody pc)
938+ traversePrepared_ createPostElementRowsQ $ elementsToRows pId (map stripPostElement $ postCreationBody pc)
760 return pId
939 return pId
761 _ -> lift $ S.throwError S.err404
940 _ -> lift $ S.throwError S.err404
762
941
763createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)
942createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)
764createNewChannel uId req = commitedTransactionallyUpdate $ do
943createNewChannel uId req = commitedTransactionallyUpdate $ do
765− uIds <- verifiedUsers . toList $ namedChannelCreationRequestPeopleIds req
944+ let uIds = toList $ namedChannelCreationRequestPeopleIds req
945+ verifyUsers uIds
766 cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow
946 cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow
767 return $ fmap fromOnly cId
947 return $ fmap fromOnly cId
768
948
949+channelCountForUser :: UserId -> StaticPQ Int64
950+channelCountForUser uId = (fromMaybe 0 . fmap fromOnly) <$> (runQueryParams countChannelsQ (Only uId) >>= firstRow)
951+
769updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()
952updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()
770−updateChannel uId req = commitedTransactionallyUpdate $ do
953+updateChannel uId req = do
771− uIds <- fmap fromList . verifiedUsers . toList $ namedChannelPeopleIds req
954+ let uIds = namedChannelPeopleIds req
955+ verifyUsers (toList uIds)
772 _ <- getChannelForUser uId $ namedChannelId req
956 _ <- getChannelForUser uId $ namedChannelId req
773− _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})
957+ _ <- commitedTransactionallyUpdate $ manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})
774 return ()
958 return ()
775
959
776getFaculty :: Text -> StaticPQ Faculty
960getFaculty :: Text -> StaticPQ Faculty
777getFaculty t = runQueryParams getFacultyQ (Only t) >>= firstRow >>= fromMaybe404
961getFaculty t = runQueryParams getFacultyQ (Only t) >>= firstRow >>= fromMaybe404
778
962
963+isValidFaculty :: FacultyUrl -> StaticPQ Bool
964+isValidFaculty url = do
965+ (faculty :: Maybe Faculty) <- runQueryParams getFacultyQ (Only url) >>= firstRow
966+ return $ isJust faculty
967+
779updateFaculty :: Faculty -> StaticPQ ()
968updateFaculty :: Faculty -> StaticPQ ()
780updateFaculty fac = void $ manipulateParams updateFacultyQ fac
969updateFaculty fac = void $ manipulateParams updateFacultyQ fac
781
970
@@ -812,13 +1001,13 @@ getAllChannels uId = fmap (map removeUserFromChannel) $
812 runQueryParams getAllChannelsForUserQ (Only uId) >>= getRows
1001 runQueryParams getAllChannelsForUserQ (Only uId) >>= getRows
813
1002
814deleteNamedChannel :: UserId -> NamedChannelId -> StaticPQ ()
1003deleteNamedChannel :: UserId -> NamedChannelId -> StaticPQ ()
815−deleteNamedChannel uId cId = commitedTransactionallyUpdate $ do
1004+deleteNamedChannel uId cId = do
816 _ <- getChannelForUser uId cId
1005 _ <- getChannelForUser uId cId
817− _ <- manipulateParams deleteNamedChannelQ (Only cId)
1006+ _ <- commitedTransactionallyUpdate $ manipulateParams deleteNamedChannelQ (Only cId)
818 return ()
1007 return ()
819
1008
820−getTags :: StaticPQ [String]
1009+getTags :: Limit -> StaticPQ [String]
821−getTags = map fromOnly <$> (runQuery getTagsQ >>= getRows)
1010+getTags lim = map fromOnly <$> (runQuery (getNpopularTagsQ lim) >>= getRows)
822
1011
823getDialogs
1012getDialogs
824 :: UserId
1013 :: UserId
@@ -851,36 +1040,40 @@ getMessagesInGroupChat
851getMessagesInGroupChat selfId gId mId lim dir = do
1040getMessagesInGroupChat selfId gId mId lim dir = do
852 _ <- getGroupChatForUser selfId gId
1041 _ <- getGroupChatForUser selfId gId
853 resp <- runQueryParams (getGroupMessagesQ lim dir) (gId, mId) >>= getRows
1042 resp <- runQueryParams (getGroupMessagesQ lim dir) (gId, mId) >>= getRows
854− (return . sequence . map restoreMessage $ resp) >>= fromMaybe500
1043+ return . catMaybes . map restoreMessage $ resp
855
1044
856sendMessage :: UserId -> MessageCreation -> StaticPQ MessageId
1045sendMessage :: UserId -> MessageCreation -> StaticPQ MessageId
857−sendMessage selfId (MessageCreation (Just gId) uId@Nothing body) = do
1046+sendMessage selfId (MessageCreation (Just gId) uId@Nothing (Jsonb body)) = do
858 _ <- getGroupChatForUser selfId gId
1047 _ <- getGroupChatForUser selfId gId
859− (Only mId) <- manipulateParams createMessageQ (selfId, Just gId, uId, body)
1048+ (Only mId) <- manipulateParams createMessageQ (selfId, Just gId, uId, Jsonb $ stripPostElement body)
860 >>= firstRow >>= fromMaybe500
1049 >>= firstRow >>= fromMaybe500
861 return mId
1050 return mId
862−sendMessage selfId (MessageCreation gId@Nothing (Just uId) body) = do
1051+sendMessage selfId (MessageCreation gId@Nothing (Just uId) (Jsonb body)) = do
1052+ verifyUsers [uId]
863− (Only mId) <- manipulateParams createMessageQ (selfId, gId, Just uId, body)
1053+ (Only mId) <- manipulateParams createMessageQ (selfId, gId, Just uId, Jsonb $ stripPostElement body)
864 >>= firstRow >>= fromMaybe500
1054 >>= firstRow >>= fromMaybe500
865 return mId
1055 return mId
866sendMessage _ _ = lift $ S.throwError S.err400
1056sendMessage _ _ = lift $ S.throwError S.err400
867
1057
868createGroupChat :: UserId -> GroupChatCreation -> StaticPQ GroupChatId
1058createGroupChat :: UserId -> GroupChatCreation -> StaticPQ GroupChatId
869createGroupChat uId (GroupChatCreation (Jsonb chatUsers) name) = do
1059createGroupChat uId (GroupChatCreation (Jsonb chatUsers) name) = do
1060+ verifyUsers . M.keys $ chatUsers
1061+ commitedTransactionallyUpdate $ do
870− let chatUsers' = M.insert uId maxChatPermissions chatUsers
1062+ let chatUsers' = M.insert uId maxChatPermissions chatUsers
871− (Only chatId) <- manipulateParams createGroupChatQ (GroupChatCreation (Jsonb chatUsers') name)
1063+ (Only chatId) <- manipulateParams createGroupChatQ (GroupChatCreation (Jsonb chatUsers') name)
872− >>= firstRow >>= fromMaybe500
1064+ >>= firstRow >>= fromMaybe500
873− -- TODO: Do somehting with this
1065+ _ <- manipulateParams createPhantomMessageQ (Only chatId)
874− _ <- sendMessage uId $ MessageCreation (Just chatId) Nothing (Jsonb $ Markdown "henlo")
875− return chatId
1066+ return chatId
876
1067
877updateGroupChat :: UserId -> GroupChat -> StaticPQ ()
1068updateGroupChat :: UserId -> GroupChat -> StaticPQ ()
878−updateGroupChat uId (GroupChat gId (Jsonb perms) name) = commitedTransactionallyUpdate $ do
1069+updateGroupChat uId (GroupChat gId (Jsonb perms) name) = do
1070+ verifyUsers . M.keys $ perms
1071+ commitedTransactionallyUpdate $ do
879− (GroupChat _ (Jsonb perms') _) <- getGroupChatForUser uId gId
1072+ (GroupChat _ (Jsonb perms') _) <- getGroupChatForUser uId gId
880− let userPerm = fromMaybe minChatPermissions $ M.lookup uId perms'
1073+ let userPerm = fromMaybe minChatPermissions $ M.lookup uId perms'
881− unless (isAdmin userPerm) $ lift $ S.throwError $ S.err401
1074+ unless (isAdmin userPerm) $ lift $ S.throwError $ S.err401
882− let newPerms = M.insert uId userPerm perms
1075+ let newPerms = M.insert uId userPerm perms
883− void $ manipulateParams updateGroupChatQ (GroupChat gId (Jsonb newPerms) name)
1076+ void $ manipulateParams updateGroupChatQ (GroupChat gId (Jsonb newPerms) name)
884
1077
885leaveGroupChat :: UserId -> GroupChatId -> StaticPQ ()
1078leaveGroupChat :: UserId -> GroupChatId -> StaticPQ ()
886leaveGroupChat uId gId = commitedTransactionallyUpdate $ do
1079leaveGroupChat uId gId = commitedTransactionallyUpdate $ do
@@ -897,30 +1090,60 @@ getGroupChatForUser uId gId = do
897 (Just c) -> return c
1090 (Just c) -> return c
898 Nothing -> lift $ S.throwError S.err404
1091 Nothing -> lift $ S.throwError S.err404
899
1092
1093+groupChatIsValidForUser :: UserId -> GroupChatId -> StaticPQ Bool
1094+groupChatIsValidForUser uId gId = do
1095+ (chat :: Maybe GroupChat) <- runQueryParams getGroupChatForUserQ (show uId, gId) >>= firstRow
1096+ return $ isJust chat
1097+
900getFacultyFromQuery :: T.Text -> StaticPQ [Faculty]
1098getFacultyFromQuery :: T.Text -> StaticPQ [Faculty]
901getFacultyFromQuery query =
1099getFacultyFromQuery query =
902− runQueryParams getFacultySearchResultQ (Only . queryFromText $ query) >>= getRows
1100+ runQueryParams getFacultySearchResultQ (Only . queryFromTextAbbr $ query) >>= getRows
1101+
1102+searchUsers :: T.Text -> StaticPQ [User Faculty]
1103+searchUsers query = do
1104+ unless (validateText query) $ lift $ throwError lengthExceeded
1105+ if (T.null . T.filter isAlpha $ query)
1106+ then return []
1107+ else map rowToUser <$> (runQueryParams searchUsersQ (Only . queryFromText $ query) >>= getRows)
1108+
1109+searchTags :: T.Text -> StaticPQ [Text]
1110+searchTags "" = return []
1111+searchTags query = map fromOnly <$>
1112+ (runQueryParams searchTagsQ
1113+ (Only . (<> ":*") . T.strip $ query) >>= getRows)
903
1114
904createToken :: Token -> StaticPQ ()
1115createToken :: Token -> StaticPQ ()
905createToken token = void $ manipulateParams createTokenQ token
1116createToken token = void $ manipulateParams createTokenQ token
906
1117
1118+killAllTokens :: UserId -> StaticPQ ()
1119+killAllTokens = void . manipulateParams killAllTokensQ . Only
1120+
1121+pruneAuth :: StaticPQ ()
1122+pruneAuth = do
1123+ _ <- commitedTransactionallyUpdate . manipulate $ pruneDeadTokensQ
1124+ _ <- commitedTransactionallyUpdate . manipulate $ pruneGhostUsersQ
1125+ return ()
1126+
1127+searchChannels :: UserId -> Text -> StaticPQ [NamedChannel UserId]
1128+searchChannels uId query = fmap (map removeUserFromChannel) $
1129+ runQueryParams searchChannelsForUserQ (uId, queryFromText query) >>= getRows
907
1130
908-- NOTE: Not transactional
1131-- NOTE: Not transactional
909validateToken :: Token -> StaticPQ ()
1132validateToken :: Token -> StaticPQ ()
910validateToken token = do
1133validateToken token = do
911− void $ manipulateParams updateTokenQ token{tokenVerificationCode = Nothing}
1134+ void $ manipulateParams updateTokenQ token{tokenVerificationCode = Nothing, tokenActivationCode = Nothing}
912 void $ manipulateParams validateUserQ $ Only $ tokenUserId token
1135 void $ manipulateParams validateUserQ $ Only $ tokenUserId token
913
1136
914invalidateToken :: UserId -> ByteString -> StaticPQ ()
1137invalidateToken :: UserId -> ByteString -> StaticPQ ()
915invalidateToken uId bs = void . manipulateParams deleteTokenQ $ (uId, bs)
1138invalidateToken uId bs = void . manipulateParams deleteTokenQ $ (uId, bs)
916
1139
917−tryVerifyToken :: UserId -> ByteString -> Int32 -> StaticPQ (Maybe Token)
1140+tryVerifyToken :: UserId -> ByteString -> Int -> StaticPQ (Maybe Token)
918tryVerifyToken uId tokenData code = commitedTransactionallyUpdate $ do
1141tryVerifyToken uId tokenData code = commitedTransactionallyUpdate $ do
919− token' <- runQueryParams getTokenQ (uId, tokenData) >>= firstRow
1142+ token' <- runQueryParams getTokenQ (uId, hash tokenData) >>= firstRow
920 case token' of
1143 case token' of
921 Nothing -> return Nothing
1144 Nothing -> return Nothing
922 Just token -> do
1145 Just token -> do
923− if (tokenVerificationCode token == Just code)
1146+ if (tokenVerificationCode token == Just (hashVerificationCode code))
924 then validateToken token >> (return $ Just token)
1147 then validateToken token >> (return $ Just token)
925 else do
1148 else do
926 let triesLeft = tokenActivationTriesLeft token - 1
1149 let triesLeft = tokenActivationTriesLeft token - 1
@@ -931,11 +1154,37 @@ tryVerifyToken uId tokenData code = commitedTransactionallyUpdate $ do
931 _ <- manipulateParams updateTokenQ newToken
1154 _ <- manipulateParams updateTokenQ newToken
932 return Nothing
1155 return Nothing
933
1156
1157+tryActivateToken :: UserId -> ByteString -> StaticPQ (Maybe Token)
1158+tryActivateToken uId activationData = do
1159+ let hData = hash activationData
1160+ token' <- runQueryParams getTokenActivationQ (uId, hData) >>= firstRow
1161+ case token' of
1162+ Nothing -> return Nothing
1163+ Just token -> do
1164+ if (tokenActivationCode token == Just hData)
1165+ then commitedTransactionallyUpdate (validateToken token) >> (return $ Just token)
1166+ else return Nothing
1167+
1168+deactivateToken :: UserId -> ByteString -> StaticPQ (Maybe Text)
1169+deactivateToken uId dData = fmap fromOnly <$> (manipulateParams deactivateTokenQ (uId, hash dData) >>= firstRow)
1170+
934getVerifiedToken :: UserId -> ByteString -> StaticPQ (Maybe Token)
1171getVerifiedToken :: UserId -> ByteString -> StaticPQ (Maybe Token)
935−getVerifiedToken uId tokenData = runQueryParams getVerifiedTokenQ (uId, tokenData) >>= firstRow
1172+getVerifiedToken uId tokenData = runQueryParams getVerifiedTokenQ (uId, hash tokenData) >>= firstRow
1173+
1174+updateUser :: (UserUpdateRow) -> StaticPQ (Maybe UserId)
1175+updateUser user = fmap fromOnly <$> (manipulateParams updateUserQ (normalizeUser user) >>= firstRow)
936
1176
937-- MARK: Utils
1177-- MARK: Utils
938
1178
1179+normalizeUser :: UserUpdateRow -> UserUpdateRow
1180+normalizeUser UserUpdateRow{..} = UserUpdateRow {
1181+ userUpdateRowId = userUpdateRowId,
1182+ userUpdateRowFirstName = T.strip $ userUpdateRowFirstName,
1183+ userUpdateRowMiddleName = T.strip $ userUpdateRowMiddleName,
1184+ userUpdateRowLastName = T.strip $ userUpdateRowLastName,
1185+ userUpdateRowUserFaculty = T.toLower . T.strip $ userUpdateRowUserFaculty
1186+}
1187+
939data UserRow = UserRow {
1188data UserRow = UserRow {
940 userRowId :: UserId,
1189 userRowId :: UserId,
941 userRowFirstName :: Text,
1190 userRowFirstName :: Text,
@@ -949,7 +1198,8 @@ data UserRow = UserRow {
949 userRowFacultyPath :: T.Text,
1198 userRowFacultyPath :: T.Text,
950 userRowFacultyCampusName :: T.Text,
1199 userRowFacultyCampusName :: T.Text,
951 userRowFacultyCampusCode :: T.Text,
1200 userRowFacultyCampusCode :: T.Text,
952− userRowFacultyTags :: V.Vector T.Text
1201+ userRowFacultyTags :: V.Vector T.Text,
1202+ userRowFacultyAddress :: T.Text
953} deriving (GHC.Generic, SOP.Generic, SOP.HasDatatypeInfo)
1203} deriving (GHC.Generic, SOP.Generic, SOP.HasDatatypeInfo)
954
1204
955rowToUser :: UserRow -> User Faculty
1205rowToUser :: UserRow -> User Faculty
@@ -964,13 +1214,27 @@ rowToUser UserRow{..} = User {
964 facultyPath = userRowFacultyPath,
1214 facultyPath = userRowFacultyPath,
965 facultyCampusName = userRowFacultyCampusName,
1215 facultyCampusName = userRowFacultyCampusName,
966 facultyCampusCode = userRowFacultyCampusCode,
1216 facultyCampusCode = userRowFacultyCampusCode,
967− facultyTags = userRowFacultyTags
1217+ facultyTags = userRowFacultyTags,
1218+ facultyAddress = userRowFacultyAddress
968 },
1219 },
969 userEmail = userRowEmail
1220 userEmail = userRowEmail
970 }
1221 }
971
1222
1223+queryFromTextAbbr :: Text -> Text
1224+queryFromTextAbbr = T.unwords . L.intersperse "&" . map processTerm . filter (not . T.null) . T.split (not . isAlphaNum)
1225+ where
1226+ processTerm :: Text -> Text
1227+ processTerm t = "(" <> t <> ":*" <> (
1228+ if T.length t <= 5
1229+ then (" | (" <>) . (<> ")") . T.unwords . L.intersperse "<->" . map (<> ":*") . map T.singleton . T.unpack $ t
1230+ else mempty
1231+ ) <> ")"
1232+
972queryFromText :: Text -> Text
1233queryFromText :: Text -> Text
973−queryFromText = T.unwords . L.intersperse "&" . map (`T.append` ":*") . filter (not . T.null) . T.split (not . isAlphaNum)
1234+queryFromText = T.unwords . L.intersperse "&" . map processTerm . filter (not . T.null) . T.split (not . isPrint)
1235+ where
1236+ processTerm :: Text -> Text
1237+ processTerm t = t <> ":*"
974
1238
975directionToOperator
1239directionToOperator
976 :: P.PaginationDirection
1240 :: P.PaginationDirection
denis/src/Data/Schema.hs+11−9
@@ -29,7 +29,8 @@ type Schema =
29 "facultyPath" ::: 'NoDef :=> 'NotNull 'PGtext,
29 "facultyPath" ::: 'NoDef :=> 'NotNull 'PGtext,
30 "facultyCampusName" ::: 'NoDef :=> 'NotNull 'PGtext,
30 "facultyCampusName" ::: 'NoDef :=> 'NotNull 'PGtext,
31 "facultyCampusCode" ::: 'NoDef :=> 'NotNull 'PGtext,
31 "facultyCampusCode" ::: 'NoDef :=> 'NotNull 'PGtext,
32− "facultyTags" ::: 'NoDef :=> 'NotNull ('PGvararray ('NotNull 'PGtext))
32+ "facultyTags" ::: 'NoDef :=> 'NotNull ('PGvararray ('NotNull 'PGtext)),
33+ "facultyAddress" ::: 'NoDef :=> 'NotNull 'PGtext
33 ]),
34 ]),
34 "users" ::: 'Table ( '[
35 "users" ::: 'Table ( '[
35 "pk_users" ::: 'PrimaryKey '["userRowId"],
36 "pk_users" ::: 'PrimaryKey '["userRowId"],
@@ -150,10 +151,10 @@ type Schema =
150 ] :=>
151 ] :=>
151 '[
152 '[
152 "messageStorageId" ::: 'Def :=> 'NotNull 'PGint8,
153 "messageStorageId" ::: 'Def :=> 'NotNull 'PGint8,
153− "messageStorageAuthorId" ::: 'NoDef :=> 'NotNull 'PGint8,
154+ "messageStorageAuthorId" ::: 'NoDef :=> 'Null 'PGint8,
154 "messageStorageDestinationGroupId" ::: 'NoDef :=> 'Null 'PGint8,
155 "messageStorageDestinationGroupId" ::: 'NoDef :=> 'Null 'PGint8,
155 "messageStorageDestinationUserId" ::: 'NoDef :=> 'Null 'PGint8,
156 "messageStorageDestinationUserId" ::: 'NoDef :=> 'Null 'PGint8,
156− "messageStorageBody" ::: 'NoDef :=> 'NotNull (PG (Jsonb (PostElement Message))),
157+ "messageStorageBody" ::: 'NoDef :=> 'Null (PG (Jsonb (PostElement Message))),
157 "messageStorageTime" ::: 'NoDef :=> 'NotNull 'PGtimestamptz
158 "messageStorageTime" ::: 'NoDef :=> 'NotNull 'PGtimestamptz
158 ]),
159 ]),
159 "tokens" ::: 'Table (
160 "tokens" ::: 'Table (
@@ -165,7 +166,7 @@ type Schema =
165 "tokenUserId" ::: 'NoDef :=> 'NotNull 'PGint8,
166 "tokenUserId" ::: 'NoDef :=> 'NotNull 'PGint8,
166 "tokenValue" ::: 'NoDef :=> 'NotNull 'PGbytea,
167 "tokenValue" ::: 'NoDef :=> 'NotNull 'PGbytea,
167 "tokenExpiryDate" ::: 'NoDef :=> 'NotNull 'PGtimestamptz,
168 "tokenExpiryDate" ::: 'NoDef :=> 'NotNull 'PGtimestamptz,
168− "tokenVerificationCode" ::: 'NoDef :=> 'Null 'PGint4, -- null == verified
169+ "tokenVerificationCode" ::: 'NoDef :=> 'Null 'PGbytea, -- null == verified
169 "tokenActivationTriesLeft" ::: 'NoDef :=> 'NotNull 'PGint4,
170 "tokenActivationTriesLeft" ::: 'NoDef :=> 'NotNull 'PGint4,
170 "tokenUserAgent" ::: 'NoDef :=> 'NotNull 'PGtext,
171 "tokenUserAgent" ::: 'NoDef :=> 'NotNull 'PGtext,
171 "tokenActivationCode" ::: 'NoDef :=> 'Null 'PGbytea,
172 "tokenActivationCode" ::: 'NoDef :=> 'Null 'PGbytea,
@@ -195,7 +196,8 @@ createTables = createTable #faculties (
195 notNullable text `as` #facultyPath :*
196 notNullable text `as` #facultyPath :*
196 notNullable text `as` #facultyCampusName :*
197 notNullable text `as` #facultyCampusName :*
197 notNullable text `as` #facultyCampusCode :*
198 notNullable text `as` #facultyCampusCode :*
198− notNullable (vararray text) `as` #facultyTags
199+ notNullable (vararray text) `as` #facultyTags :*
200+ notNullable text `as` #facultyAddress
199 ) (
201 ) (
200 primaryKey #facultyUrl `as` #pk_faculties
202 primaryKey #facultyUrl `as` #pk_faculties
201 ) >>> createTable #users (
203 ) >>> createTable #users (
@@ -209,7 +211,7 @@ createTables = createTable #faculties (
209 ) (
211 ) (
210 primaryKey #userRowId `as` #pk_users :*
212 primaryKey #userRowId `as` #pk_users :*
211 unique #userRowEmail `as` #user_email :*
213 unique #userRowEmail `as` #user_email :*
212− foreignKey #userRowFacultyUrl #faculties #facultyUrl OnDeleteCascade OnUpdateCascade `as` #fk_user_faculty
214+ foreignKey #userRowFacultyUrl #faculties #facultyUrl OnDeleteRestrict OnUpdateCascade `as` #fk_user_faculty
213 ) >>> createTable #posts (
215 ) >>> createTable #posts (
214 serial8 `as` #postRowId :*
216 serial8 `as` #postRowId :*
215 notNullable int8 `as` #postRowAuthorId :*
217 notNullable int8 `as` #postRowAuthorId :*
@@ -277,10 +279,10 @@ createTables = createTable #faculties (
277 primaryKey #groupChatId `as` #pk_group_chats
279 primaryKey #groupChatId `as` #pk_group_chats
278 ) >>> createTable #messages (
280 ) >>> createTable #messages (
279 serial8 `as` #messageStorageId :*
281 serial8 `as` #messageStorageId :*
280− notNullable int8 `as` #messageStorageAuthorId :*
282+ nullable int8 `as` #messageStorageAuthorId :*
281 nullable int8 `as` #messageStorageDestinationGroupId :*
283 nullable int8 `as` #messageStorageDestinationGroupId :*
282 nullable int8 `as` #messageStorageDestinationUserId :*
284 nullable int8 `as` #messageStorageDestinationUserId :*
283− notNullable jsonb `as` #messageStorageBody :*
285+ nullable jsonb `as` #messageStorageBody :*
284 notNullable timestampWithTimeZone `as` #messageStorageTime
286 notNullable timestampWithTimeZone `as` #messageStorageTime
285 ) (
287 ) (
286 primaryKey #messageStorageId `as` #pk_messages :*
288 primaryKey #messageStorageId `as` #pk_messages :*
@@ -291,7 +293,7 @@ createTables = createTable #faculties (
291 notNullable int8 `as` #tokenUserId :*
293 notNullable int8 `as` #tokenUserId :*
292 notNullable bytea `as` #tokenValue :*
294 notNullable bytea `as` #tokenValue :*
293 notNullable timestampWithTimeZone `as` #tokenExpiryDate :*
295 notNullable timestampWithTimeZone `as` #tokenExpiryDate :*
294− nullable int4 `as` #tokenVerificationCode :*
296+ nullable bytea `as` #tokenVerificationCode :*
295 notNullable int4 `as` #tokenActivationTriesLeft :*
297 notNullable int4 `as` #tokenActivationTriesLeft :*
296 notNullable text `as` #tokenUserAgent :*
298 notNullable text `as` #tokenUserAgent :*
297 nullable bytea `as` #tokenActivationCode :*
299 nullable bytea `as` #tokenActivationCode :*
denis/src/Data/Tags/Completions.hs+10−9
@@ -18,25 +18,26 @@ import Data.Bifunctor
18import Data.Maybe
18import Data.Maybe
19import GHC.Generics
19import GHC.Generics
20import Servant.Docs
20import Servant.Docs
21+import Data.Char
21
22
22−instance ToSample (CompletionTree Char) where
23+instance ToSample CompletionTree where
23 toSamples _ = singleSample . mkCompletionTree $
24 toSamples _ = singleSample . mkCompletionTree $
24 ["aa", "aaab", "ba", "b", "bab"]
25 ["aa", "aaab", "ba", "b", "bab"]
25
26
26−data CompletionTree a = CompletionTreeNode {
27+data CompletionTree = CompletionTreeNode {
27− value :: Maybe [a],
28+ value :: Maybe String,
28− subtree :: M.Map a (CompletionTree a)
29+ subtree :: M.Map Char CompletionTree
29 } deriving (Show, Generic)
30 } deriving (Show, Generic)
30
31
31−instance ToJSON (CompletionTree Char) where
32+instance ToJSON CompletionTree where
32
33
33−mkCompletionTree :: (Ord a) => [[a]] -> CompletionTree a
34+mkCompletionTree :: [String] -> CompletionTree
34−mkCompletionTree = mkCompletionTree' . map (\ a -> (a, a)) . sort
35+mkCompletionTree = mkCompletionTree' . map (\ a -> (map toLower a, a)) . sort
35 where
36 where
36− mkCompletionTree' :: (Ord a) => [([a], [a])] -> CompletionTree a
37+ mkCompletionTree' :: [(String, String)] -> CompletionTree
37 mkCompletionTree' = uncurry CompletionTreeNode . bimap listToMaybe (M.map mkCompletionTree' . M.fromList) .
38 mkCompletionTree' = uncurry CompletionTreeNode . bimap listToMaybe (M.map mkCompletionTree' . M.fromList) .
38 second (map (\ u@((k,_):_) -> (k, map snd u)) . groupBy ((==) `on` fst)) . partitionEithers . map processGroup
39 second (map (\ u@((k,_):_) -> (k, map snd u)) . groupBy ((==) `on` fst)) . partitionEithers . map processGroup
39 where
40 where
40− processGroup :: ([a], [a]) -> Either [a] (a, ([a], [a]))
41+ processGroup :: (String, String) -> Either String (Char, (String, String))
41 processGroup ([], b) = Left b
42 processGroup ([], b) = Left b
42 processGroup ((k:rest), aa) = Right (k, (rest, aa))
43 processGroup ((k:rest), aa) = Right (k, (rest, aa))
denis/src/Data/Tags/Suggestions.hsdeleted−24
@@ -1,24 +0,0 @@
1−{-# LANGUAGE
2− LambdaCase,
3− FlexibleInstances,
4− OverloadedStrings #-}
5−{-# OPTIONS_GHC -Wno-orphans #-}
6−
7−module Data.Tags.Suggestions (
8− suggestTags
9− ) where
10−
11−import qualified Data.Text as T
12−import Servant.Docs
13−import Data.List
14−
15−instance {-# Overlapping #-} ToSample [T.Text] where
16− toSamples _ = singleSample ["machineLearning", "cs"]
17−
18−suggestTags :: T.Text -> [T.Text]
19−suggestTags t =
20− let
21− ws = T.words t
22− l = length ws
23− indecies = take (3 + (l `mod` 3)) . map (`mod` l) $ [8849, 11161, 12647, 14081, 16267]
24− in nub . map (ws !!) $ indecies
denis/src/Data/Tags/Validation.hsnew file+25
@@ -0,0 +1,25 @@
1+module Data.Tags.Validation (
2+ validateTag,
3+ validateTag'
4+ ) where
5+
6+import Data.Text as T
7+import Data.Char as C
8+import qualified Data.Set as S
9+
10+validateTag :: T.Text -> Maybe T.Text
11+validateTag tag =
12+ let
13+ normalised = T.strip $ tag
14+ in if validateTag' normalised
15+ then Just normalised
16+ else Nothing
17+
18+validateTag' :: T.Text -> Bool
19+validateTag' = T.all validChar
20+
21+validChars :: S.Set Char
22+validChars = S.fromList "йцукенгшщзхъфывапролджэёячсмитьбюqwertyuiopasdfghjklzxcvbnm1234567890_"
23+
24+validChar :: Char -> Bool
25+validChar c = S.member (C.toLower c) validChars
denis/src/Data/Text/Validator.hsnew file+59
@@ -0,0 +1,59 @@
1+{-# LANGUAGE FlexibleInstances #-}
2+
3+module Data.Text.Validator (
4+ HasValidatableText(..),
5+ isValidChar,
6+ ExtraPredicate(..),
7+ (~=),
8+ (~<),
9+ (<~>),
10+ RangeableText(..)
11+ ) where
12+
13+import qualified Data.Text as T
14+import Data.Char
15+import Data.Limits
16+
17+isValidChar :: Char -> Bool
18+isValidChar '\n' = True
19+isValidChar '\r' = True
20+isValidChar c = isPrint c || generalCategory c == ModifierLetter
21+
22+class HasValidatableText t where
23+ validateText :: t -> Bool
24+
25+data ExtraPredicate t = ExtraPredicate t (t -> Bool)
26+
27+infixl 5 ~=
28+(~=) :: t -> (t -> Bool) -> ExtraPredicate t
29+(~=) = ExtraPredicate
30+
31+instance (HasValidatableText t) => HasValidatableText (ExtraPredicate t) where
32+ validateText (t `ExtraPredicate` p) = validateText t && p t
33+
34+
35+infixl 5 ~<
36+(~<) :: t -> Int -> RangeableText t
37+t ~< n = t <~> (0, n)
38+
39+infixl 5 <~>
40+(<~>) :: t -> (Int, Int) -> RangeableText t
41+(<~>) = RangeableText
42+
43+data RangeableText t = RangeableText t (Int, Int)
44+
45+instance HasValidatableText (RangeableText String) where
46+ validateText (t `RangeableText` (lower, upper)) = len >= lower && len <= upper && validateText t
47+ where
48+ len = length t
49+
50+instance HasValidatableText (RangeableText T.Text) where
51+ validateText (t `RangeableText` (lower, upper)) = len >= lower && len <= upper && validateText t
52+ where
53+ len = T.length t
54+
55+instance HasValidatableText T.Text where
56+ validateText t = T.all isValidChar t && (not . T.null) t && T.length t < globalTextLimit
57+
58+instance HasValidatableText String where
59+ validateText t = all isValidChar t && length t > 0 && length t < globalTextLimit
denis/src/Data/User.hs+33−2
@@ -6,12 +6,14 @@
6 TypeApplications ,
6 TypeApplications ,
7 TypeOperators,
7 TypeOperators,
8 OverloadedStrings,
8 OverloadedStrings,
9− DeriveAnyClass #-}
9+ DeriveAnyClass,
10+ RecordWildCards #-}
10
11
11module Data.User (
12module Data.User (
12 User(..),
13 User(..),
13 UserId,
14 UserId,
14− UserEmail
15+ UserEmail,
16+ UserUpdate(..)
15) where
17) where
16
18
17import Data.Int (Int64)
19import Data.Int (Int64)
@@ -21,12 +23,21 @@ import Data.Text (Text)
21import Data.Aeson
23import Data.Aeson
22import Servant.Docs (ToSample, toSamples, samples)
24import Servant.Docs (ToSample, toSamples, samples)
23import Data.Proxy
25import Data.Proxy
26+import Data.Faculty
27+import Data.Limits
28+import Data.Text.Validator
24
29
25-- MARK: Documentation
30-- MARK: Documentation
26
31
27instance (ToSample f) => ToSample (User f) where
32instance (ToSample f) => ToSample (User f) where
28 toSamples _ = samples $ [User 8 "Vasya" "Pupkinovuch" "Pupkin", User 69 "Seva" "Algebrovich" "Leonidov"] <*> (map snd $ toSamples Proxy) <*> ["foo@hse.ru"]
33 toSamples _ = samples $ [User 8 "Vasya" "Pupkinovuch" "Pupkin", User 69 "Seva" "Algebrovich" "Leonidov"] <*> (map snd $ toSamples Proxy) <*> ["foo@hse.ru"]
29
34
35+instance ToSample (UserUpdate) where
36+ toSamples _ = samples $ [UserUpdate "Vasya" "Pupkinovuch" "Pupkin", UserUpdate "Seva" "Algebrovich" "Leonidov"] <*> ["cs.hse.ru/dse/"]
37+
38+instance HasValidatableText UserUpdate where
39+ validateText UserUpdate{..} = all (validateText . (~< userFieldLengthLimit)) [userUpdateFirstName, userUpdateMiddleName, userUpdateLastName, userUpdateUserFaculty]
40+
30-- MARK: Implementation
41-- MARK: Implementation
31
42
32type UserId = Int64
43type UserId = Int64
@@ -54,3 +65,23 @@ instance (ToJSON f) => ToJSON (User f) where
54instance (FromJSON f) => FromJSON (User f) where
65instance (FromJSON f) => FromJSON (User f) where
55 parseJSON = withObject "named channel" $ \e ->
66 parseJSON = withObject "named channel" $ \e ->
56 User <$> e .: "id" <*> e .: "firstName" <*> e .: "middleName" <*> e .: "lastName" <*> e .: "faculty" <*> e .: "email"
67 User <$> e .: "id" <*> e .: "firstName" <*> e .: "middleName" <*> e .: "lastName" <*> e .: "faculty" <*> e .: "email"
68+
69+data UserUpdate = UserUpdate {
70+ userUpdateFirstName :: Text,
71+ userUpdateMiddleName :: Text,
72+ userUpdateLastName :: Text,
73+ userUpdateUserFaculty :: FacultyUrl
74+} deriving (GHC.Generic, SOP.Generic, SOP.HasDatatypeInfo)
75+
76+instance ToJSON UserUpdate where
77+ toJSON (UserUpdate fName mName lName faculty) = object [
78+ "firstName" .= fName,
79+ "middleName" .= mName,
80+ "lastName" .= lName,
81+ "faculty" .= faculty
82+ ]
83+
84+instance FromJSON UserUpdate where
85+ parseJSON = withObject "user creation" $ \e ->
86+ UserUpdate <$> e .: "firstName" <*> e .: "middleName" <*> e .: "lastName" <*> e .: "faculty"
87+
denis/src/Server/API.hs+40−3
@@ -3,7 +3,8 @@
3 DataKinds,
3 DataKinds,
4 TypeOperators,
4 TypeOperators,
5 OverloadedStrings,
5 OverloadedStrings,
6− ScopedTypeVariables #-}
6+ ScopedTypeVariables,
7+ RecordWildCards #-}
7{-# OPTIONS_GHC -Wno-orphans #-}
8{-# OPTIONS_GHC -Wno-orphans #-}
8
9
9module Server.API (
10module Server.API (
@@ -31,6 +32,11 @@ import Server.API.Completions
31import Server.API.Messages
32import Server.API.Messages
32import Data.Faculty
33import Data.Faculty
33import Server.API.Faculty
34import Server.API.Faculty
35+import Data.Text (Text)
36+import Data.Maybe (isJust)
37+import Control.Monad.Except
38+import Server.Error
39+import Data.Text.Validator
34
40
35-- MARK: Documentation
41-- MARK: Documentation
36
42
@@ -38,6 +44,11 @@ instance HasDocs api => HasDocs (Authentication :> api) where
38 docsFor Proxy (endpoint, action) =
44 docsFor Proxy (endpoint, action) =
39 docsFor (Proxy :: Proxy api) (endpoint, action & notes <>~ [DocNote "Authentication" ["This method requires cookies set in the `POST /authenticate` method.\n\nReturns error `498 Invalid Token` if the token is invalid or the token header is missing. Returns `401 Unathorized` if the token doesn't permit access to the requested data."]])
45 docsFor (Proxy :: Proxy api) (endpoint, action & notes <>~ [DocNote "Authentication" ["This method requires cookies set in the `POST /authenticate` method.\n\nReturns error `498 Invalid Token` if the token is invalid or the token header is missing. Returns `401 Unathorized` if the token doesn't permit access to the requested data."]])
40
46
47+type UserSearchDescription = Description "Searches for users with the given string.\n\nFeed in the raw user input string."
48+
49+type UpdateUserDescription = Description "Updates the current user.\n\nThrow 401 if you try to change email or something like that."
50+
51+type DeactivateAllDescription = Description "Deactivates all tokens for the logged in user including the one used to authenticate this request."
41
52
42-- MARK: Implementation
53-- MARK: Implementation
43
54
@@ -48,8 +59,12 @@ type API =
48 "authentication" :> AuthenticationHandler :<|>
59 "authentication" :> AuthenticationHandler :<|>
49 Authentication :> ComplexQuery :> (
60 Authentication :> ComplexQuery :> (
50 "authentication" :> "me" :> Post '[JSON] UserId :<|>
61 "authentication" :> "me" :> Post '[JSON] UserId :<|>
62+ "deactivateAll" :> DeactivateAllDescription
63+ :> DeleteNoContent '[JSON, PlainText, FormUrlEncoded] NoContent :<|>
51 "users" :> ReqBody '[JSON] [UserId] :> Post '[JSON] [User Faculty] :<|>
64 "users" :> ReqBody '[JSON] [UserId] :> Post '[JSON] [User Faculty] :<|>
52 "users" :> "all" :> Post '[JSON] [User Faculty] :<|>
65 "users" :> "all" :> Post '[JSON] [User Faculty] :<|>
66+ "users" :> "search" :> UserSearchDescription :> ReqBody '[JSON, PlainText] Text :> Post '[JSON] [User Faculty] :<|>
67+ "users" :> "update" :> UpdateUserDescription :> ReqBody '[JSON] UserUpdate :> PostNoContent '[JSON, PlainText] NoContent :<|>
53 "posts" :> PostApi :<|>
68 "posts" :> PostApi :<|>
54 "channels" :> ChannelsApi :<|>
69 "channels" :> ChannelsApi :<|>
55 MessagesApi
70 MessagesApi
@@ -65,11 +80,33 @@ mkServerAPI l =
65 l :<|>
80 l :<|>
66 authenticationAPI :<|> (\uId ->
81 authenticationAPI :<|> (\uId ->
67 return uId :<|>
82 return uId :<|>
83+ deactivateApi uId :<|>
68 maybeNotFound . runQnotFound . getUsers :<|>
84 maybeNotFound . runQnotFound . getUsers :<|>
69− runQnotFound getAllUsers :<|>
85+ runQerror getAllUsers :<|>
86+ runQerror . searchUsers :<|>
87+ updateUserApi uId :<|>
70 postApi uId :<|>
88 postApi uId :<|>
71 channelsApi uId :<|>
89 channelsApi uId :<|>
72 messagesServer uId
90 messagesServer uId
73 ) :<|>
91 ) :<|>
74 tagsServer :<|>
92 tagsServer :<|>
75− facultyServer
93+ facultyServer
94+
95+updateUserApi :: UserId -> UserUpdate -> App NoContent
96+updateUserApi uId UserUpdate{..} = do
97+ unless (validateText $ userUpdateUserFaculty ~< 100) $ throwError lengthExceeded
98+ facultyIsValid <- runQerror $ isValidFaculty userUpdateUserFaculty
99+ unless (facultyIsValid) $ throwError impossibleContent
100+ res <- runQ impossibleContent $ updateUser UserUpdateRow {
101+ userUpdateRowId = uId,
102+ userUpdateRowFirstName = userUpdateFirstName,
103+ userUpdateRowMiddleName = userUpdateMiddleName,
104+ userUpdateRowLastName = userUpdateLastName,
105+ userUpdateRowUserFaculty = userUpdateUserFaculty
106+ }
107+ if isJust res
108+ then return NoContent
109+ else throwError err401
110+
111+deactivateApi :: UserId -> App NoContent
112+deactivateApi uId = runQerror (killAllTokens uId) >> return NoContent
denis/src/Server/API/Channels.hs+45−11
@@ -4,7 +4,8 @@
4 OverloadedLabels,
4 OverloadedLabels,
5 OverloadedStrings ,
5 OverloadedStrings ,
6 TypeApplications ,
6 TypeApplications ,
7− TypeOperators #-}
7+ TypeOperators,
8+ RecordWildCards #-}
8
9
9module Server.API.Channels (
10module Server.API.Channels (
10 ChannelsApi,
11 ChannelsApi,
@@ -21,40 +22,73 @@ import Data.Channel.NamedChannel
21import Data.Channel.AnonymousChannel
22import Data.Channel.AnonymousChannel
22import qualified Data.Post as P
23import qualified Data.Post as P
23import Server.Query.Pagination
24import Server.Query.Pagination
25+import Server.Error
26+import Data.Text (Text)
27+import Data.Text.Validator
28+import Control.Monad
29+import Data.Limits
30+import qualified Data.Text as T
31+import Data.Char
32+
33+type CreateDescription = Description "Creates a new channel\n\nReturns 406 if the channel limit has been exceeded."
34+
35+type SearchDescription = Description "Search for user channels."
24
36
25-- MARK: Implementation
37-- MARK: Implementation
26
38
27type ChannelsApi = Post '[JSON] [NamedChannel UserId] :<|>
39type ChannelsApi = Post '[JSON] [NamedChannel UserId] :<|>
28 "get" :> ReqBody '[JSON] (PaginatingRequest P.PostId (Maybe NamedChannelId)) :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>
40 "get" :> ReqBody '[JSON] (PaginatingRequest P.PostId (Maybe NamedChannelId)) :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>
29 "getAnonymous" :> ReqBody '[JSON] (PaginatingRequest P.PostId (Maybe AnonymousChannel)) :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>
41 "getAnonymous" :> ReqBody '[JSON] (PaginatingRequest P.PostId (Maybe AnonymousChannel)) :> Post '[JSON] (ResponseWithUsers [P.Post]) :<|>
30− "create" :> ReqBody '[JSON] NamedChannelCreationRequest :> Post '[JSON] NamedChannelId :<|>
42+ "create" :> CreateDescription :> ReqBody '[JSON] NamedChannelCreationRequest :> Post '[JSON] NamedChannelId :<|>
31 "update" :> ReqBody '[JSON] (NamedChannel UserId) :> PostNoContent '[JSON, FormUrlEncoded, PlainText] NoContent :<|>
43 "update" :> ReqBody '[JSON] (NamedChannel UserId) :> PostNoContent '[JSON, FormUrlEncoded, PlainText] NoContent :<|>
32− "delete" :> ReqBody '[JSON] NamedChannelId :> PostNoContent '[JSON, FormUrlEncoded, PlainText] NoContent
44+ "delete" :> ReqBody '[JSON] NamedChannelId :> PostNoContent '[JSON, FormUrlEncoded, PlainText] NoContent :<|>
45+ "search" :> SearchDescription :> ReqBody '[JSON, PlainText] Text :> Post '[JSON] [NamedChannel UserId]
33
46
34channelsApi :: UserId -> ServerT ChannelsApi App
47channelsApi :: UserId -> ServerT ChannelsApi App
35−channelsApi uId = getChannelsApi uId :<|> getChannel uId :<|> getAnonymousChannelsApi :<|> createChannelApi uId :<|> updateChannelApi uId :<|> deleteChannelApi uId
48+channelsApi uId = getChannelsApi uId :<|> getChannel uId :<|> getAnonymousChannelsApi :<|> createChannelApi uId :<|> updateChannelApi uId :<|> deleteChannelApi uId :<|> searchChannelsApi uId
36
49
37
50
38getChannelsApi :: UserId -> App [NamedChannel UserId]
51getChannelsApi :: UserId -> App [NamedChannel UserId]
39getChannelsApi uId = runQnotFound $ getAllChannels uId
52getChannelsApi uId = runQnotFound $ getAllChannels uId
40
53
41getAnonymousChannelsApi :: PaginatingRequest P.PostId (Maybe AnonymousChannel) -> App (ResponseWithUsers [P.Post])
54getAnonymousChannelsApi :: PaginatingRequest P.PostId (Maybe AnonymousChannel) -> App (ResponseWithUsers [P.Post])
42−getAnonymousChannelsApi (PaginatingRequest pId lim (Just req) dir) = runQnotFound $ getAnonymousChannelPosts pId lim dir req
55+getAnonymousChannelsApi req'@(PaginatingRequest pId lim (Just req) dir) = do
56+ unless (validateText req && validatePaginationRequest req') $ throwError lengthExceeded
57+ runQnotFound $ getAnonymousChannelPosts pId lim dir req
43−getAnonymousChannelsApi (PaginatingRequest pId lim Nothing dir) = maybeNotFound . runQnotFound $ getLastPosts pId lim dir
58+getAnonymousChannelsApi req@(PaginatingRequest pId lim Nothing dir) = do
59+ unless (validatePaginationRequest req) $ throwError lengthExceeded
60+ maybeNotFound . runQnotFound $ getLastPosts pId lim dir
44
61
45getChannel :: UserId -> PaginatingRequest P.PostId (Maybe NamedChannelId) -> App (ResponseWithUsers [P.Post])
62getChannel :: UserId -> PaginatingRequest P.PostId (Maybe NamedChannelId) -> App (ResponseWithUsers [P.Post])
46−getChannel uId (PaginatingRequest pId lim (Just cId) dir) = runQnotFound $ getChannelPosts uId pId lim dir cId
63+getChannel uId req@(PaginatingRequest pId lim (Just cId) dir) = do
64+ unless (validatePaginationRequest req) $ throwError lengthExceeded
65+ runQnotFound $ getChannelPosts uId pId lim dir cId
66+getChannel _ req@(PaginatingRequest pId lim Nothing dir) = do
67+ unless (validatePaginationRequest req) $ throwError lengthExceeded
47−getChannel _ (PaginatingRequest pId lim Nothing dir) = maybeNotFound . runQnotFound $ getLastPosts pId lim dir
68+ maybeNotFound . runQnotFound $ getLastPosts pId lim dir
48
69
49createChannelApi :: UserId -> NamedChannelCreationRequest -> App NamedChannelId
70createChannelApi :: UserId -> NamedChannelCreationRequest -> App NamedChannelId
71+createChannelApi uId req = do
72+ cCount <- runQerror $ channelCountForUser uId
73+ unless (validateText req) $ throwError lengthExceeded
74+ if cCount >= channelCountLimit
75+ then throwError $ amountExceeded
50−createChannelApi uId req = maybeNotFound . runQnotFound $ createNewChannel uId req
76+ else maybeNotFound . runQerror $ createNewChannel uId req
51
77
52updateChannelApi :: UserId -> NamedChannel UserId -> App NoContent
78updateChannelApi :: UserId -> NamedChannel UserId -> App NoContent
53−updateChannelApi uId req = do
79+updateChannelApi uId req@NamedChannel{..} = do
80+ unless (validateText req) $ throwError lengthExceeded
54 runQnotFound $ updateChannel uId req
81 runQnotFound $ updateChannel uId req
55 return NoContent
82 return NoContent
56
83
57deleteChannelApi :: UserId -> NamedChannelId -> App NoContent
84deleteChannelApi :: UserId -> NamedChannelId -> App NoContent
58deleteChannelApi uId cId = do
85deleteChannelApi uId cId = do
59 runQnotFound $ deleteNamedChannel uId cId
86 runQnotFound $ deleteNamedChannel uId cId
60− return NoContent
87+ return NoContent
88+
89+searchChannelsApi :: UserId -> Text -> App [NamedChannel UserId]
90+searchChannelsApi uId query = do
91+ unless (validateText query) $ throwError lengthExceeded
92+ if (T.null . T.filter (not . isSpace) . T.filter isPrint) query
93+ then return []
94+ else runQerror . searchChannels uId $ query
denis/src/Server/API/Completions.hs+17−14
@@ -18,11 +18,11 @@ import Data.Tags.Completions
18import Server.App
18import Server.App
19import Data.Connection
19import Data.Connection
20import Data.Query
20import Data.Query
21+import Data.Text (Text)
22+import Data.Tags.Validation
23+import Server.Error
21import qualified Data.Text as T
24import qualified Data.Text as T
22−import qualified Data.Post as P
25+import Data.Char
23−import Data.PostElement
24−import Data.Tags.Suggestions
25−import Data.List
26
26
27type CompletionsDescription = Description "\
27type CompletionsDescription = Description "\
28 \Gets tag completion tree\n\n\
28 \Gets tag completion tree\n\n\
@@ -63,18 +63,21 @@ type CompletionsDescription = Description "\
63 \}\n\
63 \}\n\
64 \```"
64 \```"
65
65
66−type SuggestionDescription = Description "Retuens suggested tags for given post element objects."
66+type SearchDescription = Description "Returns top 1000 tag completions for given user input."
67
67
68−type TagsAPI = "completions" :> CompletionsDescription :> Get '[JSON] (CompletionTree Char)
68+type TagsAPI = "completions" :> CompletionsDescription :> Get '[JSON] CompletionTree :<|>
69− :<|> "suggest" :> SuggestionDescription :> ReqBody '[JSON] [PostElement P.Post] :> Post '[JSON] [T.Text]
69+ "search" :> SearchDescription :> ReqBody '[JSON, PlainText] Text :> Post '[JSON] [Text]
70
70
71tagsServer :: ServerT TagsAPI App
71tagsServer :: ServerT TagsAPI App
72−tagsServer = completionHandler :<|> suggestionHandler
72+tagsServer = completionHandler :<|> tagSearch
73
73
74−completionHandler :: App (CompletionTree Char)
74+completionHandler :: App CompletionTree
75−completionHandler = runQerror $ mkCompletionTree <$> getTags
75+completionHandler = runQerror $ mkCompletionTree <$> getTags 1000
76
76
77−suggestionHandler :: [PostElement P.Post] -> App [T.Text]
77+tagSearch :: Text -> App [Text]
78−suggestionHandler = return . suggestTags . T.concat . intersperse " " . concatMap (\case
78+tagSearch query' =
79− Markdown t -> T.words t
79+ if T.null . T.filter (not . isSpace) . T.filter isPrint $ query'
80− _ -> [])
80+ then return []
81+ else do
82+ query <- fromMaybeThrow formatError . return $ validateTag query'
83+ runQerror . searchTags $ query
denis/src/Server/API/Faculty.hs+11−1
@@ -18,7 +18,12 @@ import Server.App
18import Data.Connection
18import Data.Connection
19import Data.Query
19import Data.Query
20import Data.Text (Text)
20import Data.Text (Text)
21+import qualified Data.Text as T
21import Data.Faculty
22import Data.Faculty
23+import Data.Text.Validator
24+import Control.Monad
25+import Server.Error
26+import Data.Char
22
27
23type SearchDescription = Description "Returns faculties for given string"
28type SearchDescription = Description "Returns faculties for given string"
24
29
@@ -29,4 +34,9 @@ facultyServer :: ServerT FacultyAPI App
29facultyServer = search
34facultyServer = search
30
35
31search :: Text -> App [Faculty]
36search :: Text -> App [Faculty]
37+search query = do
38+ if T.null . T.filter (not . isSpace) . T.filter isPrint $ query
39+ then return []
40+ else do
41+ unless (validateText query) $ throwError lengthExceeded
32−search = runQerror . getFacultyFromQuery
42+ runQerror . getFacultyFromQuery $ query
denis/src/Server/API/Messages.hs+35−9
@@ -4,7 +4,8 @@
4 OverloadedLabels,
4 OverloadedLabels,
5 OverloadedStrings ,
5 OverloadedStrings ,
6 TypeApplications ,
6 TypeApplications ,
7− TypeOperators #-}
7+ TypeOperators,
8+ RecordWildCards #-}
8
9
9module Server.API.Messages (
10module Server.API.Messages (
10 MessagesApi,
11 MessagesApi,
@@ -21,6 +22,12 @@ import Server.Query.Pagination
21import Data.Message
22import Data.Message
22import Data.GroupChat
23import Data.GroupChat
23import Server.Query.Dialog
24import Server.Query.Dialog
25+import Data.Text.Validator
26+import Control.Monad
27+import Server.Error
28+import qualified Data.Map as M
29+import Squeal.PostgreSQL.Schema
30+import Data.Limits
24
31
25type GetAllChatsDescription = Description "Gets chats starting from/ending with the given message id."
32type GetAllChatsDescription = Description "Gets chats starting from/ending with the given message id."
26type GetGroupChatDescription = Description "Gets information about a given group chat."
33type GetGroupChatDescription = Description "Gets information about a given group chat."
@@ -58,27 +65,46 @@ messagesServer uId =
58
65
59
66
60getChats :: UserId -> PaginatingRequest MessageId (Maybe ()) -> App (ResponseWithUsers [Dialog])
67getChats :: UserId -> PaginatingRequest MessageId (Maybe ()) -> App (ResponseWithUsers [Dialog])
61−getChats uId (PaginatingRequest mId lim _ dir) = runQerror $ getDialogs uId mId lim dir
68+getChats uId req@(PaginatingRequest mId lim _ dir) = do
69+ unless (validatePaginationRequest req) $ throwError lengthExceeded
70+ runQerror $ getDialogs uId mId lim dir
62
71
63getGroupChat :: UserId -> PaginatingRequest MessageId GroupChatId -> App [Message]
72getGroupChat :: UserId -> PaginatingRequest MessageId GroupChatId -> App [Message]
64−getGroupChat uId (PaginatingRequest mId lim gId dir) =
73+getGroupChat uId req@(PaginatingRequest mId lim gId dir) = do
74+ unless (validatePaginationRequest req) $ throwError lengthExceeded
65 runQerror $ getMessagesInGroupChat uId gId mId lim dir
75 runQerror $ getMessagesInGroupChat uId gId mId lim dir
66
76
67getUserChat :: UserId -> PaginatingRequest MessageId UserId -> App [Message]
77getUserChat :: UserId -> PaginatingRequest MessageId UserId -> App [Message]
68−getUserChat uId (PaginatingRequest mId lim dId dir) =
78+getUserChat uId req@(PaginatingRequest mId lim dId dir) = do
79+ unless (validatePaginationRequest req) $ throwError lengthExceeded
69 runQerror $ getMessagesInUserChat uId dId mId lim dir
80 runQerror $ getMessagesInUserChat uId dId mId lim dir
70
81
71getGroupChatInfo :: UserId -> GroupChatId -> App GroupChat
82getGroupChatInfo :: UserId -> GroupChatId -> App GroupChat
83+getGroupChatInfo uId gId = do
84+ groupIsValid <- runQerror $ groupChatIsValidForUser uId gId
85+ unless (groupIsValid) $ throwError impossibleContent
72−getGroupChatInfo uId gId = runQerror $ getGroupChatForUser uId gId
86+ runQerror $ getGroupChatForUser uId gId
73
87
74updateGroupChatApi :: UserId -> GroupChat -> App NoContent
88updateGroupChatApi :: UserId -> GroupChat -> App NoContent
89+updateGroupChatApi uId group = do
90+ unless (validateText group) $ throwError lengthExceeded
91+ groupIsValid <- runQerror $ groupChatIsValidForUser uId (groupChatId group)
92+ unless (groupIsValid) $ throwError impossibleContent
75−updateGroupChatApi uId group = runQerror (updateGroupChat uId group) >> return NoContent
93+ runQerror (updateGroupChat uId group) >> return NoContent
76
94
77sendMessageApi :: UserId -> MessageCreation -> App MessageId
95sendMessageApi :: UserId -> MessageCreation -> App MessageId
96+sendMessageApi uId mes = do
97+ unless (validateText mes) $ throwError lengthExceeded
78−sendMessageApi uId mes = runQerror $ sendMessage uId mes
98+ runQerror $ sendMessage uId mes
79
99
80createGroupChatApi :: UserId -> GroupChatCreation -> App GroupChatId
100createGroupChatApi :: UserId -> GroupChatCreation -> App GroupChatId
101+createGroupChatApi uId group@GroupChatCreation{..} = do
102+ unless (validateText group) $ throwError lengthExceeded
103+ unless ((M.size $ getJsonb groupChatCreationUsers) < groupChatSizeLimit) $ throwError amountExceeded
81−createGroupChatApi uId group = runQerror $ createGroupChat uId group
104+ runQerror $ createGroupChat uId group
82
105
83leaveChatAPI :: UserId -> GroupChatId -> App NoContent
106leaveChatAPI :: UserId -> GroupChatId -> App NoContent
107+leaveChatAPI uId gId = do
108+ groupIsValid <- runQerror $ groupChatIsValidForUser uId gId
109+ unless (groupIsValid) $ throwError impossibleContent
84−leaveChatAPI uId gIg = runQerror (leaveGroupChat uId gIg) >> return NoContent
110+ runQerror (leaveGroupChat uId gId) >> return NoContent
denis/src/Server/API/Posts.hs+16−4
@@ -19,6 +19,10 @@ import Data.Query
19import Data.User
19import Data.User
20import Data.Connection
20import Data.Connection
21import Server.Query.Pagination
21import Server.Query.Pagination
22+import Data.Limits
23+import Server.Error
24+import Control.Monad
25+import Data.Text.Validator
22
26
23-- MARK: Implementation
27-- MARK: Implementation
24
28
@@ -31,13 +35,21 @@ postApi :: UserId -> ServerT PostApi App
31postApi uId = getPostsApi :<|> lastPosts :<|> getPostsForUserApi :<|> publishPostApi uId
35postApi uId = getPostsApi :<|> lastPosts :<|> getPostsForUserApi :<|> publishPostApi uId
32
36
33getPostsApi :: [P.PostId] -> App (ResponseWithUsers [P.Post])
37getPostsApi :: [P.PostId] -> App (ResponseWithUsers [P.Post])
38+getPostsApi req = do
39+ unless (listLimit < length req) $ throwError lengthExceeded
34−getPostsApi = maybeNotFound . runQnotFound . getPosts
40+ maybeNotFound . runQnotFound . getPosts $ req
35
41
36lastPosts :: PaginatingRequest P.PostId (Maybe ()) -> App (ResponseWithUsers [P.Post])
42lastPosts :: PaginatingRequest P.PostId (Maybe ()) -> App (ResponseWithUsers [P.Post])
43+lastPosts req@(PaginatingRequest pId lim _ dir) = do
44+ unless (validatePaginationRequest req) $ throwError lengthExceeded
37−lastPosts (PaginatingRequest pId lim _ dir) = maybeNotFound . runQnotFound $ getLastPosts pId lim dir
45+ maybeNotFound . runQnotFound $ getLastPosts pId lim dir
38
46
39getPostsForUserApi :: PaginatingRequest P.PostId UserId -> App (ResponseWithUsers [P.Post])
47getPostsForUserApi :: PaginatingRequest P.PostId UserId -> App (ResponseWithUsers [P.Post])
48+getPostsForUserApi req@(PaginatingRequest pId lim uId dir) = do
49+ unless (validatePaginationRequest req) $ throwError lengthExceeded
40−getPostsForUserApi (PaginatingRequest pId lim uId dir) = maybeNotFound . runQnotFound $ getPostsForUser pId lim dir uId
50+ maybeNotFound . runQnotFound $ getPostsForUser pId lim dir uId
41
51
42publishPostApi :: UserId -> P.PostCreation -> App P.PostId
52publishPostApi :: UserId -> P.PostCreation -> App P.PostId
53+publishPostApi uId creation = do
54+ unless (validateText creation) $ throwError lengthExceeded
43−publishPostApi uId = runQerror . publishPost uId
55+ runQerror . publishPost uId $ creation
denis/src/Server/App.hs+12−3
@@ -15,7 +15,8 @@ module Server.App (
15 ask,
15 ask,
16 asks,
16 asks,
17 liftIO,
17 liftIO,
18− MailConfig(..)
18+ MailConfig(..),
19+ fromMaybeThrow
19) where
20) where
20
21
21import Servant.Server
22import Servant.Server
@@ -25,6 +26,7 @@ import Data.Schema
25import Generics.SOP (K)
26import Generics.SOP (K)
26import Squeal.PostgreSQL.PQ (Connection)
27import Squeal.PostgreSQL.PQ (Connection)
27import Crypto.RNG
28import Crypto.RNG
29+import Server.Error
28
30
29type App = ReaderT Config Handler
31type App = ReaderT Config Handler
30
32
@@ -33,7 +35,7 @@ type DBConnection = Pool (K Connection Schema)
33data Config = Config {
35data Config = Config {
34 getPool :: !DBConnection,
36 getPool :: !DBConnection,
35 cryptoState :: !CryptoRNGState,
37 cryptoState :: !CryptoRNGState,
36− -- selfRootUrl :: !String,
38+ selfRootUrl :: !String,
37 mailConfig :: !MailConfig
39 mailConfig :: !MailConfig
38}
40}
39
41
@@ -45,4 +47,11 @@ data MailConfig = MailConfig {
45}
47}
46
48
47instance CryptoRNG App where
49instance CryptoRNG App where
48− randomBytes n = join $ asks (liftIO . randomBytesIO n . cryptoState)
50+ randomBytes n = join $ asks (liftIO . randomBytesIO n . cryptoState)
51+
52+fromMaybeThrow :: ServantErr -> App (Maybe a) -> App a
53+fromMaybeThrow err mb = do
54+ a <- mb
55+ case a of
56+ Just b -> return b
57+ Nothing -> throwError err
denis/src/Server/Auth.hs+161−41
@@ -11,6 +11,7 @@
11 DeriveAnyClass,
11 DeriveAnyClass,
12 RecordWildCards #-}
12 RecordWildCards #-}
13{-# OPTIONS_GHC -Wno-orphans #-}
13{-# OPTIONS_GHC -Wno-orphans #-}
14+
14module Server.Auth (
15module Server.Auth (
15 checkToken,
16 checkToken,
16 cookieTokenKey,
17 cookieTokenKey,
@@ -19,7 +20,8 @@ module Server.Auth (
19 logIn,
20 logIn,
20 contextProxy,
21 contextProxy,
21 AuthenticationCredits(..),
22 AuthenticationCredits(..),
22− authenticationAPI
23+ authenticationAPI,
24+ TokenActivationData
23) where
25) where
24
26
25import Server.App
27import Server.App
@@ -43,17 +45,19 @@ import qualified GHC.Generics as GHC
43import Data.Aeson
45import Data.Aeson
44import qualified Data.Aeson as A
46import qualified Data.Aeson as A
45import Data.Binary.Builder (toLazyByteString)
47import Data.Binary.Builder (toLazyByteString)
46−import Servant.Docs (ToSample, samples, toSamples)
48+import Servant.Docs
47import qualified Data.Text as T
49import qualified Data.Text as T
48import qualified Data.Text.Encoding as T
50import qualified Data.Text.Encoding as T
49import Text.Regex
51import Text.Regex
50−import qualified Data.ByteString.Base64 as BS
52+import qualified Data.ByteString.Base64.URL as BS
51import Data.Maybe
53import Data.Maybe
52import Server.Auth.Token
54import Server.Auth.Token
53import Server.Auth.Mail
55import Server.Auth.Mail
54−import Data.Int
55import Web.UAParser
56import Web.UAParser
56import qualified Data.Text.Lazy as TL
57import qualified Data.Text.Lazy as TL
58+import Server.Auth.HTML
59+import Data.Char
60+import Data.Text.Validator
57
61
58-- MARK: Documentation
62-- MARK: Documentation
59
63
@@ -63,11 +67,34 @@ instance ToSample AuthenticationCredits where
63instance ToSample UserLoginResponse where
67instance ToSample UserLoginResponse where
64 toSamples _ = samples $ map UserLoginResponse [UserIsRegistered, UserCanRegister, InvalidUser]
68 toSamples _ = samples $ map UserLoginResponse [UserIsRegistered, UserCanRegister, InvalidUser]
65
69
66−instance ToSample Int32 where
70+instance ToSample Int where
67 toSamples _ = samples [382934, 103845, 294905]
71 toSamples _ = samples [382934, 103845, 294905]
68
72
69instance ToSample UserCreation where
73instance ToSample UserCreation where
70− toSamples _ = samples $ [UserCreation "Seva" "Algebrovich" "Leonidov" "cs.hse.ru/dse" "vchernyshev@hse.ru"]
74+ toSamples _ = samples $ [UserCreation "Seva" "Algebrovich" "Leonidov" "cs.hse.ru/dse/" "vchernyshev@hse.ru"]
75+
76+instance ToSample TokenActivationData where
77+ toSamples _ = singleSample $ TokenActivationData 69 "ABCDE"
78+
79+instance ToSample TokenActivationResult where
80+ toSamples _ = samples [TokenActivationResultYou, TokenActivationResultNotYou]
81+
82+instance ToParam (QueryParam' mods "data" String) where
83+ toParam _ =
84+ DocQueryParam "data"
85+ ["AAABBBC="]
86+ "The data recieved from the email."
87+ Normal
88+
89+instance ToParam (QueryParam' mods "id" UserId) where
90+ toParam _ =
91+ DocQueryParam "id"
92+ ["8"]
93+ "The id of the user."
94+ Normal
95+
96+instance ToSample Markup where
97+ toSamples _ = noSamples
71
98
72type LoginDescription = Description "Try to log in with the given email\n\nResponse fields:\n\n- `registered` -- User is registered and the cookie has been set. You now need to get a verification code from the user and pass it to `/verify`.\n- `canRegister` -- the email is valid, but the user needs to register. Prompt him for information and pass it to `/register`.\n- `invalid` -- the email is invalid."
99type LoginDescription = Description "Try to log in with the given email\n\nResponse fields:\n\n- `registered` -- User is registered and the cookie has been set. You now need to get a verification code from the user and pass it to `/verify`.\n- `canRegister` -- the email is valid, but the user needs to register. Prompt him for information and pass it to `/register`.\n- `invalid` -- the email is invalid."
73
100
@@ -79,6 +106,10 @@ type RegisterDescription = Description "Register the user for a new account.\n\n
79
106
80type CheckCookieDescription = Description "Checks if a parseable cookie is present in the request.\n\nDoes not check if the cookie itself contains valid credentials.\n\nReturns 204 NoContent if cookie is present.\n\nReturns 401 Unauthorized if the cookie is not present."
107type CheckCookieDescription = Description "Checks if a parseable cookie is present in the request.\n\nDoes not check if the cookie itself contains valid credentials.\n\nReturns 204 NoContent if cookie is present.\n\nReturns 401 Unauthorized if the cookie is not present."
81
108
109+type ActivateDescription = Description "Activates a token using data from email"
110+
111+type DeactivateDescription = Description "Deactivates a token using data from email"
112+
82-- MARK: Implementation
113-- MARK: Implementation
83
114
84type AuthenticationHandler =
115type AuthenticationHandler =
@@ -90,13 +121,28 @@ type AuthenticationHandler =
90 :> Header "cookie" String
121 :> Header "cookie" String
91 :> PostNoContent '[JSON, PlainText, FormUrlEncoded] (Headers '[Header "Set-Cookie" String] NoContent) :<|>
122 :> PostNoContent '[JSON, PlainText, FormUrlEncoded] (Headers '[Header "Set-Cookie" String] NoContent) :<|>
92 "verify" :> VerifyDescription :>
123 "verify" :> VerifyDescription :>
93− Header "cookie" String :> ReqBody '[JSON] Int32 :> PostNoContent '[JSON, PlainText, FormUrlEncoded] NoContent :<|>
124+ Header "cookie" String :> ReqBody '[JSON] Int :> PostNoContent '[JSON, PlainText, FormUrlEncoded] NoContent :<|>
94 "register" :> RegisterDescription :>
125 "register" :> RegisterDescription :>
95 ReqBody '[JSON] UserCreation :>
126 ReqBody '[JSON] UserCreation :>
96 Header "User-Agent" String :>
127 Header "User-Agent" String :>
97 PostNoContent '[JSON, PlainText, FormUrlEncoded] (Headers '[Header "Set-Cookie" String] NoContent) :<|>
128 PostNoContent '[JSON, PlainText, FormUrlEncoded] (Headers '[Header "Set-Cookie" String] NoContent) :<|>
98 "checkCookie" :> CheckCookieDescription :>
129 "checkCookie" :> CheckCookieDescription :>
99− Header "cookie" String :> GetNoContent '[JSON, PlainText, FormUrlEncoded] NoContent
130+ Header "cookie" String :> GetNoContent '[JSON, PlainText, FormUrlEncoded] NoContent :<|>
131+ "activate" :> ActivateDescription
132+ :> Header "cookie" String
133+ :> ReqBody '[JSON] TokenActivationData
134+ :> Post '[JSON] TokenActivationResult :<|>
135+ "deactivate" :> DeactivateDescription
136+ :> ReqBody '[JSON] TokenActivationData
137+ :> PostNoContent '[JSON] NoContent :<|>
138+ "activateUser"
139+ :> QueryParam "id" UserId
140+ :> QueryParam "data" String
141+ :> Get '[HTML] Markup :<|>
142+ "deactivateUser"
143+ :> QueryParam "id" UserId
144+ :> QueryParam "data" String
145+ :> Get '[HTML] Markup
100
146
101data UserResponseStatus = UserIsRegistered | UserCanRegister | InvalidUser
147data UserResponseStatus = UserIsRegistered | UserCanRegister | InvalidUser
102 deriving (Show)
148 deriving (Show)
@@ -115,6 +161,27 @@ data AuthenticationCookieData = AuthenticationCookieData {
115 cookieUserToken :: BS.ByteString
161 cookieUserToken :: BS.ByteString
116} deriving (Show, GHC.Generic, ToJSON, FromJSON)
162} deriving (Show, GHC.Generic, ToJSON, FromJSON)
117
163
164+data TokenActivationData = TokenActivationData {
165+ tokenVerificationUserId :: UserId,
166+ tokenVerificationData :: BS.ByteString
167+} deriving (Show, GHC.Generic)
168+
169+instance ToJSON TokenActivationData where
170+ toJSON (TokenActivationData uId vData) = object [
171+ "id" .= uId,
172+ "data" .= vData
173+ ]
174+
175+instance FromJSON TokenActivationData where
176+ parseJSON = withObject "token verification data" $ \ e ->
177+ TokenActivationData <$> e .: "id" <*> e .: "data"
178+
179+data TokenActivationResult = TokenActivationResultYou | TokenActivationResultNotYou
180+
181+instance ToJSON TokenActivationResult where
182+ toJSON TokenActivationResultYou = object ["you" .= True]
183+ toJSON TokenActivationResultNotYou = object ["you" .= False]
184+
118instance ToJSON BS.ByteString where
185instance ToJSON BS.ByteString where
119 toJSON = A.String . T.decodeUtf8 . BS.encode
186 toJSON = A.String . T.decodeUtf8 . BS.encode
120
187
@@ -127,8 +194,35 @@ instance FromJSON BS.ByteString where
127newtype AuthenticationCredits = AuthenticationCredits {authenticationEmail :: UserEmail}
194newtype AuthenticationCredits = AuthenticationCredits {authenticationEmail :: UserEmail}
128 deriving (GHC.Generic, ToJSON, FromJSON)
195 deriving (GHC.Generic, ToJSON, FromJSON)
129
196
197+activateUser :: Maybe UserId -> Maybe String -> App Markup
198+activateUser Nothing _ = return $ page "The link is invalid."
199+activateUser _ Nothing = return $ page "The link is invalid."
200+activateUser (Just uId) (Just aData') = catchErrorPage $ do
201+ case BS.decode . C.pack $ aData' of
202+ Left _ -> return $ page $ "The link is invalid."
203+ Right aData -> do
204+ tokenData' <- runQerror $ tryActivateToken uId aData
205+ case tokenData' of
206+ Nothing -> return $ page "This activation link has been invalidated."
207+ Just Token{..} -> return $ genActivationPage "in" tokenUserAgent
208+
209+deactivateUser :: Maybe UserId -> Maybe String -> App Markup
210+deactivateUser Nothing _ = return $ page "The link is invalid."
211+deactivateUser _ Nothing = return $ page "The link is invalid."
212+deactivateUser (Just uId) (Just dData') = catchErrorPage $ do
213+ case BS.decode . C.pack $ dData' of
214+ Left _ -> return $ page $ "The link is invalid."
215+ Right dData -> do
216+ ua' <- runQerror $ deactivateToken uId dData
217+ case ua' of
218+ Nothing -> return $ page "This deactivation link has been invalidated."
219+ Just ua -> return $ genActivationPage "out" ua
220+
221+catchErrorPage :: App Markup -> App Markup
222+catchErrorPage = flip catchError $ \ (_ :: ServantErr) -> return errorPage
223+
130authenticationAPI :: ServerT AuthenticationHandler App
224authenticationAPI :: ServerT AuthenticationHandler App
131−authenticationAPI = logIn :<|> logOut :<|> verifyToken :<|> register :<|> checkCookie
225+authenticationAPI = logIn :<|> logOut :<|> verifyToken :<|> register :<|> checkCookie :<|> validateTokenApi :<|> deactivateTokenApi :<|> activateUser :<|> deactivateUser
132
226
133logIn :: AuthenticationCredits -> Maybe String -> App (Headers '[Header "Set-Cookie" String] UserLoginResponse)
227logIn :: AuthenticationCredits -> Maybe String -> App (Headers '[Header "Set-Cookie" String] UserLoginResponse)
134logIn (AuthenticationCredits email') ua' = do
228logIn (AuthenticationCredits email') ua' = do
@@ -141,21 +235,16 @@ logIn (AuthenticationCredits email') ua' = do
141 Nothing -> return . noHeader $ UserLoginResponse UserCanRegister
235 Nothing -> return . noHeader $ UserLoginResponse UserCanRegister
142 Just User{..} -> do
236 Just User{..} -> do
143 let ua = getUserAgent ua'
237 let ua = getUserAgent ua'
144− token <- generateToken userId ua
238+ GeneratedToken token value code activation deactivation <- generateToken userId ua
145 runQerror . createToken $ token
239 runQerror . createToken $ token
146− let cookie = generateCookie token
240+ let cookie = generateCookie token value
147− case tokenVerificationCode token of
148− Just code -> do
149− sendTokenVerificationEmail code (TL.fromStrict ua) email
241+ sendTokenVerificationEmail code userId (BS.encode activation) (BS.encode deactivation) (TL.fromStrict ua) email
150− return . addHeader cookie $ UserLoginResponse UserIsRegistered
242+ return . addHeader cookie $ UserLoginResponse UserIsRegistered
151− Nothing -> throwError err500
243+
152−
153−generateCookie :: Token -> String
244+generateCookie :: Token -> BS.ByteString -> String
154−generateCookie token = L.unpack . toLazyByteString . renderSetCookie $ defaultSetCookie {
245+generateCookie token value = L.unpack . toLazyByteString . renderSetCookie $ defaultSetCookie {
155 setCookieName = cookieTokenKey,
246 setCookieName = cookieTokenKey,
156− setCookieValue = L.toStrict . encode $ AuthenticationCookieData
247+ setCookieValue = L.toStrict . encode $ AuthenticationCookieData (tokenUserId token) value,
157− (tokenUserId token)
158− (tokenValue token),
159 setCookieExpires = Just (tokenExpiryDate token),
248 setCookieExpires = Just (tokenExpiryDate token),
160 setCookiePath = Just "/",
249 setCookiePath = Just "/",
161 setCookieHttpOnly = True,
250 setCookieHttpOnly = True,
@@ -171,7 +260,7 @@ checkCookie cookie = do
171 Nothing -> throwError err401
260 Nothing -> throwError err401
172 Just _ -> return NoContent
261 Just _ -> return NoContent
173
262
174−verifyToken :: Maybe String -> Int32 -> App NoContent
263+verifyToken :: Maybe String -> Int -> App NoContent
175verifyToken Nothing _ = throwError err400
264verifyToken Nothing _ = throwError err400
176verifyToken (Just cookie) code = do
265verifyToken (Just cookie) code = do
177 let mbToken = getCookie cookie
266 let mbToken = getCookie cookie
@@ -195,6 +284,26 @@ logOut cookie = do
195 setCookiePath = Just "/" }
284 setCookiePath = Just "/" }
196 return $ addHeader (L.unpack . toLazyByteString . renderSetCookie $ newCookie) NoContent
285 return $ addHeader (L.unpack . toLazyByteString . renderSetCookie $ newCookie) NoContent
197
286
287+validateTokenApi :: Maybe String -> TokenActivationData -> App TokenActivationResult
288+validateTokenApi cookie' (TokenActivationData uId aData) = do
289+ tokenData' <- runQerror $ tryActivateToken uId aData
290+ case tokenData' of
291+ Nothing -> throwError err401
292+ Just Token{..} -> do
293+ case cookie' >>= getCookie of
294+ Nothing -> return TokenActivationResultNotYou
295+ Just (AuthenticationCookieData uId' cData) ->
296+ if hash cData == tokenValue && uId' == tokenUserId
297+ then return TokenActivationResultYou
298+ else return TokenActivationResultNotYou
299+
300+deactivateTokenApi :: TokenActivationData -> App NoContent
301+deactivateTokenApi (TokenActivationData uId dData) = do
302+ res <- runQerror $ deactivateToken uId dData
303+ if isJust res
304+ then return NoContent
305+ else throwError err401
306+
198checkToken :: DBConnection -> AuthenticationCookieData -> Handler UserId
307checkToken :: DBConnection -> AuthenticationCookieData -> Handler UserId
199checkToken conn (AuthenticationCookieData uId tokenData) = do
308checkToken conn (AuthenticationCookieData uId tokenData) = do
200 token <- runQ' conn err500 $ getVerifiedToken uId tokenData
309 token <- runQ' conn err500 $ getVerifiedToken uId tokenData
@@ -205,33 +314,32 @@ checkToken conn (AuthenticationCookieData uId tokenData) = do
205register :: UserCreation -> Maybe String -> App (Headers '[Header "Set-Cookie" String] NoContent)
314register :: UserCreation -> Maybe String -> App (Headers '[Header "Set-Cookie" String] NoContent)
206register creation' ua' = do
315register creation' ua' = do
207 let creation = normalizaUser creation'
316 let creation = normalizaUser creation'
208− unless (validateUser creation) $ throwError err400
317+ unless (validateUser creation && validateText creation) $ throwError err400
318+ validFaculty <- runQerror $ isValidFaculty (userCreationUserFaculty creation)
319+ unless validFaculty $ throwError impossibleContent
209 genToken <- generateTokenM
320 genToken <- generateTokenM
210 let ua = getUserAgent ua'
321 let ua = getUserAgent ua'
211− token <- runQ err409 . commitedTransactionallyUpdate $ do
322+ GeneratedToken token value code activation deactivation <- runQ err409 . commitedTransactionallyUpdate $ do
212 uId <- createUser creation
323 uId <- createUser creation
213− let token = genToken uId ua
324+ let gToken = genToken uId ua
214− createToken token
325+ createToken . generatedToken $ gToken
215− return token
326+ return gToken
216− case tokenVerificationCode token of
217− Just code -> do
218− sendTokenVerificationEmail code (TL.fromStrict ua) (userCreationUserEmail creation)
327+ sendTokenVerificationEmail code (tokenUserId token) (BS.encode activation) (BS.encode deactivation) (TL.fromStrict ua) (userCreationUserEmail creation)
219− let cookie = generateCookie token
328+ let cookie = generateCookie token value
220− return $ addHeader cookie NoContent
329+ return $ addHeader cookie NoContent
221− Nothing -> throwError err500
222
330
223getUserAgent :: Maybe String -> T.Text
331getUserAgent :: Maybe String -> T.Text
224getUserAgent uaData' = fromMaybe "Unknown" $ do
332getUserAgent uaData' = fromMaybe "Unknown" $ do
225 uaData <- fmap C.pack uaData'
333 uaData <- fmap C.pack uaData'
226 let os = osrFamily <$> parseOS uaData
334 let os = osrFamily <$> parseOS uaData
227 let browser = uarFamily <$> parseUA uaData
335 let browser = uarFamily <$> parseUA uaData
228− foldl mappendMaybe Nothing $ [os, browser]
336+ foldl (mappendMaybeThrough " — ") Nothing $ [os, browser]
229 where
337 where
230− mappendMaybe :: (Semigroup a) => Maybe a -> Maybe a -> Maybe a
338+ mappendMaybeThrough :: (Semigroup a) => a -> Maybe a -> Maybe a -> Maybe a
231− mappendMaybe Nothing (Just a) = Just a
339+ mappendMaybeThrough _ Nothing (Just a) = Just a
232− mappendMaybe (Just a) Nothing = Just a
340+ mappendMaybeThrough _ (Just a) Nothing = Just a
233− mappendMaybe (Just a) (Just b) = Just (a <> b)
341+ mappendMaybeThrough i (Just a) (Just b) = Just (a <> i <> b)
234− mappendMaybe Nothing Nothing = Nothing
342+ mappendMaybeThrough _ Nothing Nothing = Nothing
235
343
236normalizaUser :: UserCreation -> UserCreation
344normalizaUser :: UserCreation -> UserCreation
237normalizaUser (UserCreation fName mName lName faculty email) =
345normalizaUser (UserCreation fName mName lName faculty email) =
@@ -278,8 +386,11 @@ validateEmail :: T.Text -> Bool
278validateEmail "ilyakooo0@gmail.com" = True
386validateEmail "ilyakooo0@gmail.com" = True
279validateEmail "rednikina.com@yandex.ru" = True
387validateEmail "rednikina.com@yandex.ru" = True
280validateEmail "admikhaleva@edu.hse.ru" = True
388validateEmail "admikhaleva@edu.hse.ru" = True
389+validateEmail e = if all validChar email
281−validateEmail e = (isJust . matchRegex regex . T.unpack $ e) || (isJust . matchRegex falseRegex . T.unpack $ e)
390+ then ((isJust . matchRegex regex $ email) || (isJust . matchRegex falseRegex $ email))
391+ else False
282 where
392 where
393+ email = T.unpack $ e
283 regex = mkRegexWithOpts
394 regex = mkRegexWithOpts
284 "^[A-Z0-9a-z._%-]+@hse\\.ru$"
395 "^[A-Z0-9a-z._%-]+@hse\\.ru$"
285 False
396 False
@@ -288,3 +399,12 @@ validateEmail e = (isJust . matchRegex regex . T.unpack $ e) || (isJust . matchR
288 "^[A-Z0-9a-z._%-+]+@edu.hse\\.ru$"
399 "^[A-Z0-9a-z._%-+]+@edu.hse\\.ru$"
289 False
400 False
290 False
401 False
402+
403+validChar :: Char -> Bool
404+validChar c = isAscii c && isPrint c
405+
406+-- checkString :: String -> App String
407+-- checkString s =
408+-- if any invalidChar s
409+-- then throwError formatError
410+-- else return s
denis/src/Server/Auth/HTML.hsnew file+49
@@ -0,0 +1,49 @@
1+{-# LANGUAGE DataKinds,
2+ DeriveGeneric,
3+ FlexibleContexts,
4+ FlexibleInstances,
5+ MultiParamTypeClasses,
6+ OverloadedStrings,
7+ ScopedTypeVariables,
8+ TypeFamilies,
9+ TypeOperators,
10+ UndecidableInstances,
11+ DeriveAnyClass,
12+ RecordWildCards #-}
13+
14+module Server.Auth.HTML (
15+ HTML,
16+ genActivationPage,
17+ Markup,
18+ errorPage,
19+ page
20+ ) where
21+
22+import Servant.HTML.Blaze
23+import Text.Blaze.Html5 as H
24+import Text.Blaze.XHtml5.Attributes as A
25+import Data.Text (Text)
26+
27+genActivationPage :: Text -> Text -> Markup
28+genActivationPage verb ua = genPage $ do
29+ "You have successfully "
30+ u $ do
31+ "logged "
32+ toHtml verb
33+ " on "
34+ u $ toHtml ua
35+
36+
37+genPage :: Markup -> Markup
38+genPage pageContent = html $ do
39+ H.head $ do
40+ meta ! name "viewport" ! content "width=device-width, initial-scale=1"
41+ body ! A.style "font-family: sans-serif; background-color: #f8f8f8" $ do
42+ H.div ! A.style "text-align: center; margin-top: 20vh; margin-left: 10%; margin-right: 10%" $ do
43+ H.div ! A.style "font-size: 40px; font-weight: bold;" $ pageContent
44+
45+errorPage :: Markup
46+errorPage = genPage $ "Sorry, something went wrong."
47+
48+page :: Text -> Markup
49+page t = genPage $ toHtml t
denis/src/Server/Auth/Mail.hs+34−7
@@ -23,22 +23,49 @@ import Control.Monad.IO.Class
23import Network.Mail.Mime (Mail, Part)
23import Network.Mail.Mime (Mail, Part)
24import Data.Text (Text)
24import Data.Text (Text)
25import qualified Data.Text.Lazy as TL
25import qualified Data.Text.Lazy as TL
26+import Text.Blaze.Html5 as H
27+import Text.Blaze.XHtml5.Attributes as A
28+import Text.Blaze.Html.Renderer.Text
29+import Data.ByteString (ByteString)
30+import Data.User
31+import Data.ByteString.Char8 (unpack)
26
32
27−sendTokenVerificationEmail :: TokenVerificationCode -> TL.Text -> Text -> App ()
33+sendTokenVerificationEmail :: TokenVerificationCode -> UserId -> ByteString -> ByteString -> TL.Text -> Text -> App ()
28−sendTokenVerificationEmail code ua email = do
34+sendTokenVerificationEmail userCode uId activation deactivation ua email = do
35+ cfg <- ask
29− mailCfg <- mailConfig <$> ask
36+ let mailCfg = mailConfig cfg
37+ let rootUrl = selfRootUrl cfg
30 let mail = simpleMail
38 let mail = simpleMail
31 (Address (Just "HSE Social Network") "noreply@hse.ru")
39 (Address (Just "HSE Social Network") "noreply@hse.ru")
32 [Address Nothing email] [] []
40 [Address Nothing email] [] []
33 "HSE Social Network Verification Code"
41 "HSE Social Network Verification Code"
34− [genMail code ua]
42+ [genMail rootUrl userCode uId (unpack activation) (unpack deactivation) ua]
35 sendMailWithConfig mailCfg mail
43 sendMailWithConfig mailCfg mail
36
44
37sendMailWithConfig :: (MonadIO m) => MailConfig -> Mail -> m ()
45sendMailWithConfig :: (MonadIO m) => MailConfig -> Mail -> m ()
38sendMailWithConfig (MailConfig host port user pass) =
46sendMailWithConfig (MailConfig host port user pass) =
39 liftIO . sendMailWithLogin' host (fromIntegral port) user pass
47 liftIO . sendMailWithLogin' host (fromIntegral port) user pass
40
48
41−genMail :: TokenVerificationCode -> TL.Text -> Part
49+genMail :: String -> TokenVerificationCode -> UserId -> String -> String -> TL.Text -> Part
42−genMail code ua = htmlPart $ "<html><body style=\"font-family: sans-serif;\"> <h1> <div align=\"center\" style=\"margin-top: 20vh;\"> <a href=\"#\" style=\"font-size: 34px; font-weight: bold; display: inline-block; padding: 7px 13px 7px 13px; margin-bottom: 89px; text-decoration: underline; font-family: sans-serif; color: #555;\"> Log in </a> <br /> <div style=\"font-size: 34px; font-weight: bold;\"> <span style=\"color: #bbb; font-weight: bold;\">from: </span>" <> ua <> "</div> <br/> <div style=\"font-size: 55px; font-weight: bold; border-radius: 10px; background-color: #eee; display: inline-block; padding: 7px 13px 7px 13px; box-shadow: 0px 5px 21px #bbb; background-image: linear-gradient(#f9f9f9, #eee);\">" <> TL.pack [a, b] <> "<div style=\"display: inline-block; width: 13px;\"></div>" <> TL.pack [c, d] <> "<div style=\"display: inline-block; width: 13px;\"></div>" <> TL.pack [e, f] <> "</div></div><div align=\"center\" style=\"margin-top: 233px;\"> <a href=\"#\" style=\"text-decoration: underline; font-family: sans-serif; color: #555;font-size: 13px; margin-bottom: 21px;\">Revoke access</a> </div></body></html>"
50+genMail rootUrl userCode uId activation deactivation ua = htmlPart . renderHtml $ html $ body ! A.style "font-family: sans-serif;" $ do
51+ H.div ! A.style "display: none; max-height: 0px; overflow: hidden;" $ do
52+ "Verification code: " <> toHtml ua
53+ br
54+ toHtml [a', b', ' ', c', d', ' ', e', f']
55+ H.div ! A.style "display: none; max-height: 0px; overflow: hidden;" $ "            "
56+ H.div ! A.style "text-align: center; margin-top: 55px;" $ do
57+ H.a ! href (stringValue $ rootUrl <> "/authentication/activateUser?id=" <> show uId <> "&data=" <> activation) ! A.style "font-size: 34px; font-weight: bold; display: inline-block; padding: 7px 13px 7px 13px; margin-bottom: 89px; text-decoration: underline; font-family: sans-serif; color: #555;" $ "Log in"
58+ br
59+ H.div ! A.style "font-size: 34px; font-weight: bold;" $ do
60+ H.span ! A.style "color: #bbb; font-weight: bold;" $ "from: "
61+ toHtml ua
62+ br
63+ H.div ! A.style "font-size: 55px; font-weight: bold; border-radius: 10px; background-color: #eee; display: inline-block; padding: 7px 13px 7px 13px; box-shadow: 0px 5px 21px #bbb; background-image: linear-gradient(#f9f9f9, #eee);" $ do
64+ toHtml [a', b']
65+ H.div ! A.style "display: inline-block; width: 13px;" $ mempty
66+ toHtml [c', d']
67+ H.div ! A.style "display: inline-block; width: 13px;" $ mempty
68+ toHtml [e', f']
69+ H.div ! A.style "text-align: center; margin-top: 233px;" $ H.a ! href (stringValue $ rootUrl <> "/authentication/deactivateUser?id=" <> show uId <> "&data=" <> deactivation) ! A.style "text-decoration: underline; font-family: sans-serif; color: #555;font-size: 13px; margin-bottom: 21px;" $ "Revoke access"
43 where
70 where
44− [a, b, c, d, e, f] = reverse . take 6 . (++ repeat '0') . reverse . show $ code
71+ [a', b', c', d', e', f'] = reverse . take 6 . (++ repeat '0') . reverse . show $ userCode
denis/src/Server/Auth/Token.hs+28−6
@@ -13,7 +13,10 @@ module Server.Auth.Token (
13 Token(..),
13 Token(..),
14 generateToken,
14 generateToken,
15 TokenVerificationCode,
15 TokenVerificationCode,
16− generateTokenM
16+ generateTokenM,
17+ hashVerificationCode,
18+ GeneratedToken(..),
19+ hash
17 ) where
20 ) where
18
21
19import Data.Time.Clock
22import Data.Time.Clock
@@ -25,30 +28,49 @@ import Data.Int
25import Control.Monad.IO.Class
28import Control.Monad.IO.Class
26import Crypto.RNG
29import Crypto.RNG
27import Data.Text (Text)
30import Data.Text (Text)
31+import Crypto.Hash.SHA512
32+import qualified Data.ByteString.Char8 as C
28
33
29−type TokenVerificationCode = Int32
34+type TokenVerificationCode = Int
35+
36+data GeneratedToken = GeneratedToken {
37+ generatedToken :: Token,
38+ generatedTokenValue :: ByteString,
39+ generatedVerificationCode :: Int,
40+ generatedActivationCode :: ByteString,
41+ generatedDeactivationCode :: ByteString
42+}
30
43
31data Token = Token {
44data Token = Token {
32 tokenUserId :: UserId,
45 tokenUserId :: UserId,
33 tokenValue :: ByteString,
46 tokenValue :: ByteString,
34 tokenExpiryDate :: UTCTime,
47 tokenExpiryDate :: UTCTime,
35− tokenVerificationCode :: Maybe TokenVerificationCode,
48+ tokenVerificationCode :: Maybe ByteString,
36 tokenActivationTriesLeft :: Int32,
49 tokenActivationTriesLeft :: Int32,
37 tokenUserAgent :: Text,
50 tokenUserAgent :: Text,
38 tokenActivationCode :: Maybe ByteString,
51 tokenActivationCode :: Maybe ByteString,
39 tokenDeactivationCode :: ByteString
52 tokenDeactivationCode :: ByteString
40} deriving (Show, GHC.Generic, SOP.Generic, SOP.HasDatatypeInfo)
53} deriving (Show, GHC.Generic, SOP.Generic, SOP.HasDatatypeInfo)
41
54
42−generateToken :: (MonadIO m, CryptoRNG m) => UserId -> Text -> m Token
55+generateToken :: (MonadIO m, CryptoRNG m) => UserId -> Text -> m GeneratedToken
43generateToken uId ua = do
56generateToken uId ua = do
44 gen <- generateTokenM
57 gen <- generateTokenM
45 return $ gen uId ua
58 return $ gen uId ua
46
59
47−generateTokenM :: (MonadIO m, CryptoRNG m) => m (UserId -> Text -> Token)
60+generateTokenM :: (MonadIO m, CryptoRNG m) => m (UserId -> Text -> GeneratedToken)
48generateTokenM = do
61generateTokenM = do
49 token <- randomBytes 64
62 token <- randomBytes 64
50 activationToken <- randomBytes 64
63 activationToken <- randomBytes 64
51 deactivationToken <- randomBytes 64
64 deactivationToken <- randomBytes 64
52 code <- randomR (0, 999999)
65 code <- randomR (0, 999999)
53 expire <- liftIO $ fmap (addUTCTime (nominalDay * 365)) getCurrentTime -- one year
66 expire <- liftIO $ fmap (addUTCTime (nominalDay * 365)) getCurrentTime -- one year
67+ return $ \ uId ua -> GeneratedToken {
54− return $ \ uId ua -> Token uId token expire (Just code) 10 ua (Just activationToken) deactivationToken
68+ generatedToken = Token uId (hash token) expire (Just . hashVerificationCode $ code) 10 ua (Just . hash $ activationToken) (hash deactivationToken),
69+ generatedTokenValue = token,
70+ generatedVerificationCode = code,
71+ generatedActivationCode = activationToken,
72+ generatedDeactivationCode = deactivationToken
73+ }
74+
75+hashVerificationCode :: Int -> ByteString
76+hashVerificationCode = hash . C.pack . show
denis/src/Server/Error.hs+41−2
@@ -1,15 +1,54 @@
1{-# LANGUAGE OverloadedStrings #-}
1{-# LANGUAGE OverloadedStrings #-}
2
2
3module Server.Error (
3module Server.Error (
4− invalidToken
4+ invalidToken,
5+ amountExceeded,
6+ lengthExceeded,
7+ formatError,
8+ impossibleContent,
9+ throwError
5) where
10) where
6
11
7import Servant.Server
12import Servant.Server
13+import Control.Monad.Except
8
14
9invalidToken :: ServantErr
15invalidToken :: ServantErr
10invalidToken = ServantErr {
16invalidToken = ServantErr {
11 errHTTPCode = 498,
17 errHTTPCode = 498,
12 errReasonPhrase = "Invalid Token",
18 errReasonPhrase = "Invalid Token",
13− errBody = "The supplied token is invalid",
19+ errBody = "",
14 errHeaders = []
20 errHeaders = []
15}
21}
22+
23+amountExceeded :: ServantErr
24+amountExceeded = ServantErr {
25+ errHTTPCode = 470,
26+ errReasonPhrase = "The amount of elements the user can have has been exceeded.",
27+ errBody = "",
28+ errHeaders = []
29+}
30+
31+lengthExceeded :: ServantErr
32+lengthExceeded = ServantErr {
33+ errHTTPCode = 471,
34+ errReasonPhrase = "The length of user content has been exceeded.",
35+ errBody = "",
36+ errHeaders = []
37+}
38+
39+formatError :: ServantErr
40+formatError = ServantErr {
41+ errHTTPCode = 472,
42+ errReasonPhrase = "The format of the supplied content is invalid.",
43+ errBody = "",
44+ errHeaders = []
45+}
46+
47+impossibleContent :: ServantErr
48+impossibleContent = ServantErr {
49+ errHTTPCode = 473,
50+ errReasonPhrase = "The content you have supplied is invalid and/or conflict with the rest of the existing content.",
51+ errBody = "",
52+ errHeaders = []
53+}
54+
denis/src/Server/Periodic.hsnew file+29
@@ -0,0 +1,29 @@
1+module Server.Periodic (
2+ periodically,
3+ seconds,
4+ minutes,
5+ hours
6+ ) where
7+
8+import Control.Monad.IO.Class
9+import Control.Concurrent
10+import System.Random
11+import Control.Monad
12+
13+seconds :: Int
14+seconds = 1000000
15+
16+minutes :: Int
17+minutes = 60 * seconds
18+
19+hours :: Int
20+hours = 60 * minutes
21+
22+periodically :: (MonadIO m) => Int -> IO () -> m ThreadId
23+periodically delay action = liftIO $ do
24+ forkIO $ do
25+ initialDelay <- randomRIO (0, delay)
26+ threadDelay initialDelay
27+ forever $ do
28+ action
29+ threadDelay delay
denis/src/Server/Query/Dialog.hs+10−6
@@ -25,7 +25,7 @@ instance ToSample Dialog where
25 toSamples _ = samples (take 1 (UserDialog <$> [69] <*> map snd (toSamples Proxy)) <>
25 toSamples _ = samples (take 1 (UserDialog <$> [69] <*> map snd (toSamples Proxy)) <>
26 (GroupDialog <$> map snd (toSamples Proxy) <*> map snd (toSamples Proxy)))
26 (GroupDialog <$> map snd (toSamples Proxy) <*> map snd (toSamples Proxy)))
27
27
28−data Dialog = GroupDialog GroupChat Message | UserDialog UserId Message
28+data Dialog = GroupDialog GroupChat (Maybe Message) | UserDialog UserId Message
29 deriving Show
29 deriving Show
30
30
31instance ToJSON Dialog where
31instance ToJSON Dialog where
@@ -44,10 +44,10 @@ instance ToJSON Dialog where
44
44
45data ChatsResponse = ChatsResponse {
45data ChatsResponse = ChatsResponse {
46 chatResponseMessageId :: MessageId,
46 chatResponseMessageId :: MessageId,
47− chatResponseMessageAuthorId :: UserId,
47+ chatResponseMessageAuthorId :: Maybe UserId,
48 chatResponseMessageDestinationGroupId :: Maybe GroupChatId,
48 chatResponseMessageDestinationGroupId :: Maybe GroupChatId,
49 chatResponseMessageDestinationUserId :: Maybe UserId,
49 chatResponseMessageDestinationUserId :: Maybe UserId,
50− chatResponseMessageBody :: Jsonb (PostElement Message),
50+ chatResponseMessageBody :: Maybe (Jsonb (PostElement Message)),
51 chatResponseMessageTime :: UTCTime,
51 chatResponseMessageTime :: UTCTime,
52 chatResponseGroupUsers :: Maybe (Jsonb UserPermissions),
52 chatResponseGroupUsers :: Maybe (Jsonb UserPermissions),
53 chatResponseGroupName :: Maybe Text
53 chatResponseGroupName :: Maybe Text
@@ -60,13 +60,17 @@ responseToDialogs :: UserId -> [ChatsResponse] -> Maybe [Dialog]
60responseToDialogs selfId = sequence . map toDialog
60responseToDialogs selfId = sequence . map toDialog
61 where
61 where
62 toDialog :: ChatsResponse -> Maybe Dialog
62 toDialog :: ChatsResponse -> Maybe Dialog
63− toDialog (ChatsResponse mId uId Nothing (Just dId) (Jsonb mb) mt Nothing Nothing) =
63+ toDialog (ChatsResponse mId (Just uId) Nothing (Just dId) (Just (Jsonb mb)) mt Nothing Nothing) =
64 Just $ UserDialog
64 Just $ UserDialog
65 (if selfId == uId then dId else uId)
65 (if selfId == uId then dId else uId)
66 (Message mId uId (UserChatDestination dId) mb mt)
66 (Message mId uId (UserChatDestination dId) mb mt)
67− toDialog (ChatsResponse mId uId (Just gId) Nothing (Jsonb mb) mt (Just users) (Just name)) =
67+ toDialog (ChatsResponse mId (Just uId) (Just gId) Nothing (Just (Jsonb mb)) mt (Just users) (Just name)) =
68 Just $ GroupDialog
68 Just $ GroupDialog
69 (GroupChat gId users name)
69 (GroupChat gId users name)
70− (Message mId uId (GroupChatDestination gId) mb mt)
70+ (Just $ Message mId uId (GroupChatDestination gId) mb mt)
71+ toDialog (ChatsResponse _ Nothing (Just gId) Nothing Nothing _ (Just users) (Just name)) =
72+ Just $ GroupDialog
73+ (GroupChat gId users name)
74+ Nothing
71 toDialog _ = Nothing
75 toDialog _ = Nothing
72
76
denis/src/Server/Query/Pagination.hs+5−1
@@ -13,7 +13,8 @@
13
13
14module Server.Query.Pagination (
14module Server.Query.Pagination (
15 PaginatingRequest(..),
15 PaginatingRequest(..),
16− PaginationDirection(..)
16+ PaginationDirection(..),
17+ validatePaginationRequest
17 ) where
18 ) where
18
19
19import GHC.Generics
20import GHC.Generics
@@ -32,6 +33,9 @@ data PaginatingRequest i r = PaginatingRequest {
32 direction :: PaginationDirection
33 direction :: PaginationDirection
33} deriving (Generic)
34} deriving (Generic)
34
35
36+validatePaginationRequest :: (PaginatingRequest i r) -> Bool
37+validatePaginationRequest PaginatingRequest{limit=lim} = lim > 0 && lim < 100
38+
35instance (ToJSON r, ToJSON i) => ToJSON (PaginatingRequest i r) where
39instance (ToJSON r, ToJSON i) => ToJSON (PaginatingRequest i r) where
36instance (FromJSON r, FromJSON i) => FromJSON (PaginatingRequest i r) where
40instance (FromJSON r, FromJSON i) => FromJSON (PaginatingRequest i r) where
37
41
denis/src/Server/Server.hs+28−11
@@ -1,7 +1,12 @@
1+{-# LANGUAGE
1−{-# LANGUAGE OverloadedStrings #-}
2+ OverloadedStrings,
3+ TypeOperators,
4+ DataKinds #-}
2
5
3module Server.Server (
6module Server.Server (
4− runServer
7+ runServer,
8+ hoistedServer,
9+ getConfig
5) where
10) where
6
11
7import Server.API
12import Server.API
@@ -17,12 +22,12 @@ import Control.Monad.Reader
17import Network.Wai.Handler.Warp
22import Network.Wai.Handler.Warp
18import Network.HTTP.Types.Method
23import Network.HTTP.Types.Method
19import Server.Logger
24import Server.Logger
20−import Control.Concurrent
21import Data.Faculty.Parser
25import Data.Faculty.Parser
22import Data.Connection
26import Data.Connection
23import Data.Query
27import Data.Query
24import Crypto.RNG
28import Crypto.RNG
25import Network.Wai.Middleware.Cors
29import Network.Wai.Middleware.Cors
30+import Server.Periodic
26
31
27getDBString :: IO B.ByteString
32getDBString :: IO B.ByteString
28getDBString = do
33getDBString = do
@@ -45,25 +50,31 @@ getConfig = do
45 databaseURL <- getDBString
50 databaseURL <- getDBString
46 conn <- createConnectionPool databaseURL 3 0.5 10
51 conn <- createConnectionPool databaseURL 3 0.5 10
47 crypto <- newCryptoRNGState
52 crypto <- newCryptoRNGState
48− -- (Jusr selfRoot) <- lookupEnv "SELF_ROOT_URL"
53+ selfRoot <- fromMaybe "http://localhost:2000" <$> lookupEnv "SELF_ROOT_URL"
49 mail <- getMailConfig
54 mail <- getMailConfig
50− return $ Config conn crypto mail
55+ return $ Config conn crypto selfRoot mail
56+
57+hoistedServer :: Logger -> Config -> Server API
58+hoistedServer logger cfg =
59+ let serverAPI = mkServerAPI logger
60+ in hoistServerWithContext serverProxy contextProxy (flip runReaderT cfg) serverAPI
51
61
52runServer :: IO ()
62runServer :: IO ()
53runServer = do
63runServer = do
54 port <- getServerPort
64 port <- getServerPort
55 cfg <- getConfig
65 cfg <- getConfig
66+ updateFaculties cfg
56− void . forkIO $ updateFaculties cfg
67+ _ <- periodically (1 * hours) $ updateFaculties cfg
68+ _ <- periodically (20 * minutes) $ runDbTask cfg pruneAuth
57 let ctx = genAuthServerContext $ getPool cfg
69 let ctx = genAuthServerContext $ getPool cfg
58− (middleLogger, logger) <- mkLogger 100
70+ (middleLogger, logger) <- mkLogger 500
59− let serverAPI = mkServerAPI logger
71+ let s = hoistedServer logger cfg
60− let s = hoistServerWithContext serverProxy contextProxy (flip runReaderT cfg) serverAPI
61 runSettings (settings port) $ cors (const $ Just policy) . middleLogger $ serveWithContext serverProxy ctx s
72 runSettings (settings port) $ cors (const $ Just policy) . middleLogger $ serveWithContext serverProxy ctx s
62
73
63policy :: CorsResourcePolicy
74policy :: CorsResourcePolicy
64policy = CorsResourcePolicy {
75policy = CorsResourcePolicy {
65 corsOrigins = Just (["http://localhost:8080", "http://localhost:4000", "http://127.0.0.1:4000", "http://127.0.0.1:8080", "http://lvh.me:4000", "http://lvh.me:8080", "http://valera-kristina.herokuapp.com", "https://valera-kristina.herokuapp.com"], True), -- Nothing,
76 corsOrigins = Just (["http://localhost:8080", "http://localhost:4000", "http://127.0.0.1:4000", "http://127.0.0.1:8080", "http://lvh.me:4000", "http://lvh.me:8080", "http://valera-kristina.herokuapp.com", "https://valera-kristina.herokuapp.com"], True), -- Nothing,
66− corsMethods=[methodGet, methodPost],
77+ corsMethods=[methodGet, methodPost, methodDelete],
67 corsRequestHeaders = ["content-type"],
78 corsRequestHeaders = ["content-type"],
68 corsExposedHeaders = Nothing,
79 corsExposedHeaders = Nothing,
69 corsMaxAge = Nothing,
80 corsMaxAge = Nothing,
@@ -78,4 +89,10 @@ settings port = setPort port . setServerName "Denis" $ defaultSettings
78updateFaculties :: Config -> IO ()
89updateFaculties :: Config -> IO ()
79updateFaculties cfg = do
90updateFaculties cfg = do
80 fs <- getFaculties
91 fs <- getFaculties
92+ forM_ fs (runTask cfg . runQerror . updateFaculty)
93+
94+runTask :: Config -> App () -> IO ()
81− forM_ fs (runHandler . flip runReaderT cfg . runQerror . updateFaculty)
95+runTask cfg = void . runHandler . flip runReaderT cfg
96+
97+runDbTask :: Config -> StaticPQ () -> IO ()
98+runDbTask cfg = runTask cfg . runQsilent
denis/src/test/Orphans.hsnew file+104
@@ -0,0 +1,104 @@
1+{-# LANGUAGE
2+ OverloadedStrings,
3+ TypeOperators,
4+ DataKinds,
5+ FlexibleInstances,
6+ UndecidableInstances #-}
7+
8+module Orphans where
9+
10+import Server.API
11+import Server.Server
12+import Test.QuickCheck
13+import Servant.QuickCheck
14+import Test.Hspec
15+import Server.App
16+import Servant.Server
17+import Data.User
18+import Servant.Server.Experimental.Auth
19+import Network.Wai
20+import Servant.QuickCheck.Internal.HasGenRequest
21+import Servant.API
22+import Server.Query.ComplexQuery
23+import Test.QuickCheck
24+import Server.Query.Pagination
25+import Test.QuickCheck.Arbitrary.Generic
26+import Data.Post
27+import Data.Channel.NamedChannel
28+import Test.QuickCheck.Instances
29+import Server.Auth
30+import Data.Query
31+import Data.User
32+import Data.PostElement
33+import Data.Channel.AnonymousChannel
34+import Data.Channel.NamedChannel
35+import Data.GroupChat
36+import Squeal.PostgreSQL.Schema
37+import Data.Message
38+
39+instance (Arbitrary i, Arbitrary r) => Arbitrary (PaginatingRequest i r) where
40+ arbitrary = genericArbitrary
41+ shrink = genericShrink
42+
43+instance Arbitrary PaginationDirection where
44+ arbitrary = elements [BackPagination, ForwardPagination]
45+
46+instance (Arbitrary u) => Arbitrary (NamedChannel u) where
47+ arbitrary = genericArbitrary
48+ shrink = genericShrink
49+
50+instance Arbitrary AuthenticationCredits where
51+ arbitrary = genericArbitrary
52+ shrink = genericShrink
53+
54+instance Arbitrary UserCreation where
55+ arbitrary = genericArbitrary
56+ shrink = genericShrink
57+
58+instance Arbitrary TokenActivationData where
59+ arbitrary = genericArbitrary
60+ shrink = genericShrink
61+
62+instance Arbitrary UserUpdate where
63+ arbitrary = genericArbitrary
64+ shrink = genericShrink
65+
66+instance Arbitrary PostCreation where
67+ arbitrary = genericArbitrary
68+ shrink = genericShrink
69+
70+instance Arbitrary (PostElement p) where
71+ arbitrary = genericArbitrary
72+ shrink = genericShrink
73+
74+instance Arbitrary PostQuote where
75+ arbitrary = genericArbitrary
76+ shrink = genericShrink
77+
78+instance Arbitrary AnonymousChannel where
79+ arbitrary = genericArbitrary
80+ shrink = genericShrink
81+
82+instance Arbitrary NamedChannelCreationRequest where
83+ arbitrary = genericArbitrary
84+ shrink = genericShrink
85+
86+instance Arbitrary GroupChat where
87+ arbitrary = genericArbitrary
88+ shrink = genericShrink
89+
90+instance Arbitrary GroupChatPermissions where
91+ arbitrary = genericArbitrary
92+ shrink = genericShrink
93+
94+instance Arbitrary GroupChatCreation where
95+ arbitrary = genericArbitrary
96+ shrink = genericShrink
97+
98+instance Arbitrary MessageCreation where
99+ arbitrary = genericArbitrary
100+ shrink = genericShrink
101+
102+instance (Arbitrary a) => Arbitrary (Jsonb a) where
103+ arbitrary = genericArbitrary
104+ shrink = genericShrink
denis/src/test/Spec.hsnew file+101
@@ -0,0 +1,101 @@
1+{-# LANGUAGE
2+ OverloadedStrings,
3+ TypeOperators,
4+ DataKinds,
5+ FlexibleInstances,
6+ UndecidableInstances,
7+ ScopedTypeVariables #-}
8+
9+import Server.API
10+import Server.Server
11+import Test.QuickCheck
12+import Servant.QuickCheck
13+import Test.Hspec
14+import Server.App
15+import Servant.Server
16+import Data.User
17+import Servant.Server.Experimental.Auth
18+import Network.Wai
19+import Servant.QuickCheck.Internal.HasGenRequest
20+import Servant.API
21+import Server.Query.ComplexQuery
22+import Orphans
23+import qualified Network.HTTP.Client as HTTP
24+import qualified Data.ByteString.Char8 as B
25+import qualified Data.ByteString.Lazy.Char8 as LB
26+import Network.HTTP.Types.Status (statusCode)
27+
28+main :: IO ()
29+main = do
30+ cfg <- getCfg
31+
32+ hspec $ do
33+ let
34+ test :: Predicates -> IO ()
35+ test predicates = withServantServerAndContext serverProxy mockAuth
36+ (return $ hoistedServer (return "") cfg) $ \burl ->
37+ serverSatisfies serverProxy burl testArgs
38+ (printPredicate <%> predicates)
39+
40+ it "Doesn't have errors" $
41+ test $ not500 <%> mempty
42+
43+ it "Honours accept headers" $
44+ test $ honoursAcceptHeader <%> mempty
45+
46+ it "Doesn't take longer than 1 second" $
47+ test $ notLongerThan (1 * seconds) <%> mempty
48+
49+mockAuth :: Context (AuthHandler Request UserId ': '[])
50+mockAuth = mkAuthHandler (const $ return 3) :. EmptyContext
51+
52+milliseconds :: Integer
53+milliseconds = 1000000
54+
55+seconds :: Integer
56+seconds = 1000 * milliseconds
57+
58+getCfg :: IO Config
59+getCfg = do
60+ cfg <- getConfig
61+ return cfg {
62+ mailConfig = mail
63+ }
64+
65+mail :: MailConfig
66+mail = MailConfig {
67+ mailHost = "",
68+ mailPort = 25,
69+ mailUser = "",
70+ mailPassword = ""
71+}
72+
73+testArgs :: Args
74+testArgs = Args
75+ { replay = Nothing
76+ , maxSuccess = 1000
77+ , maxDiscardRatio = 10
78+ , maxSize = 100
79+ , chatty = True
80+ , maxShrinks = maxBound
81+ }
82+
83+printPredicate = RequestPredicate $ \ req mgr -> do
84+ let url = HTTP.path req
85+ let (HTTP.RequestBodyLBS bs) = HTTP.requestBody req
86+ resp <- HTTP.httpLbs req mgr
87+ let code = statusCode $ HTTP.responseStatus resp
88+ putStr "\tRequest:\t"
89+ putStrLn $ B.unpack url
90+ putStrLn . filter (/= '\a') $ LB.unpack bs
91+ putStr "\tResponse:\t"
92+ print code
93+ putStrLn ""
94+ return []
95+
96+
97+instance (HasGenRequest a) => HasGenRequest (Authentication :> a) where
98+ genRequest (Proxy :: Proxy (Authentication :> a)) = genRequest (Proxy :: Proxy a)
99+
100+instance HasGenRequest api => HasGenRequest (ComplexQuery :> api) where
101+ genRequest (Proxy :: Proxy (ComplexQuery :> api)) = genRequest (Proxy :: Proxy api)
dump.sqlnew file+499
@@ -0,0 +1,499 @@
1+
2+
3+--
4+-- Data for Name: groupChats; Type: TABLE DATA; Schema: public; Owner: qsfrneimsrtpjz
5+--
6+
7+COPY public."groupChats" ("groupChatId", "groupChatUsers", "groupChatName") FROM stdin;
8+12 {"7": {"isAdmin": false}} Untitled1
9+14 {"6": {"isAdmin": false}, "7": {"isAdmin": false}} new chat
10+15 {"7": {"isAdmin": false}} hello
11+19 {"6": {"isAdmin": false}}
12+13 {"6": {"isAdmin": true}, "7": {"isAdmin": false}} Проверка
13+18 {"3": {"isAdmin": true}, "11": {"isAdmin": false}} proverka
14+17 {"6": {"isAdmin": true}, "11": {"isAdmin": false}} Sosatt
15+22 {"6": {"isAdmin": true}} Untitled
16+23 {"6": {"isAdmin": true}} Тест
17+21 {"3": {"isAdmin": true}, "6": {"isAdmin": false}} new name of chat
18+20 {"3": {"isAdmin": true}} Untitled
19+16 {"6": {"isAdmin": true}} Hello
20+\.
21+
22+
23+--
24+-- Data for Name: messages; Type: TABLE DATA; Schema: public; Owner: qsfrneimsrtpjz
25+--
26+
27+COPY public.messages ("messageStorageId", "messageStorageAuthorId", "messageStorageDestinationGroupId", "messageStorageDestinationUserId", "messageStorageBody", "messageStorageTime") FROM stdin;
28+56 \N 12 \N \N 2019-05-12 19:00:42.217465+00
29+57 \N 13 \N \N 2019-05-12 20:00:15.500388+00
30+60 3 \N 6 {"markdown": "Идёшь завтра на лекцию???"} 2019-05-12 21:16:53.471869+00
31+61 \N 14 \N \N 2019-05-12 21:17:28.177618+00
32+62 3 12 \N {"markdown": "hello"} 2019-05-12 21:17:38.560284+00
33+63 \N 15 \N \N 2019-05-12 21:19:35.607156+00
34+64 6 \N 3 {"markdown": "Da!"} 2019-05-12 22:22:34.636955+00
35+69 6 \N 3 {"markdown": "Проверка"} 2019-05-13 09:00:04.543673+00
36+75 \N 16 \N \N 2019-05-13 09:42:35.621514+00
37+76 3 \N 6 {"markdown": "аааа я пишу с сайта "} 2019-05-13 09:51:45.216052+00
38+77 6 \N 3 {"markdown": ")))"} 2019-05-13 09:59:04.464285+00
39+78 6 \N 3 {"markdown": "Ты еще можешь отправлять сообщения на ентер"} 2019-05-13 09:59:17.664861+00
40+79 \N 17 \N \N 2019-05-13 10:34:51.369108+00
41+80 12 17 \N {"markdown": "New chat!"} 2019-05-13 10:34:59.396363+00
42+81 12 17 \N {"markdown": "Write me something pls"} 2019-05-13 10:38:06.641916+00
43+82 6 17 \N {"markdown": "Hello!"} 2019-05-13 10:39:02.53931+00
44+83 12 16 \N {"markdown": "Hello!"} 2019-05-13 10:49:47.834312+00
45+84 12 17 \N {"markdown": "Кикнула Илью из беседы)"} 2019-05-13 10:50:45.408526+00
46+85 12 17 \N {"markdown": "привет как дела"} 2019-05-13 10:58:54.034185+00
47+86 6 17 \N {"markdown": "Хорошо, а у тебя?"} 2019-05-13 11:00:03.129155+00
48+87 12 \N 3 {"markdown": "Привет!"} 2019-05-13 12:23:21.226991+00
49+88 12 \N 3 {"markdown": "Как у тебя дела?"} 2019-05-13 12:23:28.143832+00
50+89 12 17 \N {"markdown": "Ну так плюс минус жить можно)"} 2019-05-13 12:24:43.553721+00
51+90 12 17 \N {"markdown": "привет"} 2019-05-13 13:16:37.040853+00
52+91 12 17 \N {"markdown": "Всем пис"} 2019-05-13 13:16:50.7915+00
53+92 12 \N 3 {"markdown": "Аняяяя"} 2019-05-13 13:20:25.214522+00
54+93 3 \N 12 {"markdown": "Нормально"} 2019-05-13 14:08:52.660103+00
55+94 3 \N 12 {"markdown": "Ты как?"} 2019-05-13 14:09:00.358669+00
56+95 3 \N 6 {"markdown": "Я так и делала!!!"} 2019-05-13 14:09:48.991844+00
57+96 \N 18 \N \N 2019-05-13 14:18:30.872479+00
58+97 \N 19 \N \N 2019-05-13 15:24:01.710566+00
59+98 3 19 \N {"markdown": "hello"} 2019-05-13 15:27:17.523456+00
60+99 \N 20 \N \N 2019-05-13 15:27:36.736424+00
61+100 3 20 \N {"markdown": "Darya "} 2019-05-13 15:27:53.856998+00
62+101 3 20 \N {"markdown": "pls sent message"} 2019-05-13 15:28:18.065107+00
63+102 \N 21 \N \N 2019-05-13 17:23:22.627985+00
64+103 3 21 \N {"markdown": "hellooooo\\n## markdown"} 2019-05-13 17:27:35.021832+00
65+104 12 18 \N {"markdown": "Help"} 2019-05-13 17:40:57.74548+00
66+105 12 20 \N {"markdown": "Pls"} 2019-05-13 17:41:28.669253+00
67+106 12 20 \N {"markdown": "Send"} 2019-05-13 17:41:33.713239+00
68+107 12 20 \N {"markdown": "Nudes"} 2019-05-13 17:41:37.030689+00
69+108 3 \N 12 {"markdown": "i"} 2019-05-13 18:04:27.566263+00
70+109 3 \N 12 {"markdown": "need"} 2019-05-13 18:04:29.597069+00
71+110 3 \N 12 {"markdown": "a"} 2019-05-13 18:04:30.747952+00
72+111 3 \N 12 {"markdown": "lot"} 2019-05-13 18:04:32.866007+00
73+112 3 \N 12 {"markdown": "of"} 2019-05-13 18:04:34.439089+00
74+113 3 \N 12 {"markdown": "messages"} 2019-05-13 18:04:37.348507+00
75+114 3 \N 12 {"markdown": "lets"} 2019-05-13 18:04:41.274395+00
76+115 3 \N 12 {"markdown": "check "} 2019-05-13 18:04:43.225609+00
77+116 3 \N 12 {"markdown": "pagination"} 2019-05-13 18:04:46.724472+00
78+117 3 \N 12 {"markdown": "))))"} 2019-05-13 18:04:49.117602+00
79+118 3 \N 12 {"markdown": "Darya"} 2019-05-13 18:04:58.079826+00
80+119 3 \N 12 {"markdown": "chto delaesh?"} 2019-05-13 18:05:06.691576+00
81+120 3 \N 12 {"markdown": "native eeeee"} 2019-05-13 18:05:13.633699+00
82+121 3 21 \N {"markdown": "блин мне нравится сидеть с сайта"} 2019-05-13 18:38:41.575588+00
83+122 6 21 \N {"markdown": "Фига"} 2019-05-13 18:59:23.480114+00
84+123 6 21 \N {"markdown": "Неожиданно"} 2019-05-13 18:59:28.098338+00
85+124 6 21 \N {"markdown": "А еще мне тоже не хватает смайликов"} 2019-05-13 18:59:36.924505+00
86+125 6 21 \N {"markdown": "Надо бы прикрутить))"} 2019-05-13 18:59:41.452505+00
87+126 12 \N 3 {"markdown": "Привет"} 2019-05-13 19:30:55.962054+00
88+127 12 \N 3 {"markdown": "У Кости тут время не отображается сообщения, когда ты мне писать то успеваешь!!! _удивлена_ _поражена_ _раздосадована_"} 2019-05-13 19:31:22.510321+00
89+128 12 \N 3 {"markdown": "привет"} 2019-05-13 19:34:50.753794+00
90+129 12 \N 3 {"markdown": "блять ну привет ало"} 2019-05-13 19:35:21.876566+00
91+130 12 \N 3 {"markdown": "Приветттттт!"} 2019-05-13 19:36:01.406531+00
92+131 12 \N 3 {"markdown": ""} 2019-05-13 19:36:02.600456+00
93+132 12 \N 3 {"markdown": "привет"} 2019-05-13 19:36:05.515343+00
94+133 12 \N 3 {"markdown": "где сообщения????"} 2019-05-13 19:36:18.145702+00
95+134 \N 22 \N \N 2019-05-13 19:37:11.909828+00
96+135 \N 23 \N \N 2019-05-13 19:37:28.304101+00
97+136 12 \N 11 {"markdown": "Соси писю"} 2019-05-13 19:56:44.176754+00
98+137 12 \N 3 {"markdown": "Пис"} 2019-05-13 19:58:39.660301+00
99+138 11 \N 12 {"markdown": "Сама I just want people to be happy "} 2019-05-13 19:59:20.391998+00
100+139 12 \N 11 {"markdown": "Починила я твои сэйфэриа"} 2019-05-13 20:19:53.326795+00
101+140 12 \N 11 {"markdown": "Иди и make people happy again сам"} 2019-05-13 20:20:17.66819+00
102+141 6 23 \N {"markdown": "Ну что"} 2019-05-13 20:39:46.038071+00
103+142 6 22 \N {"markdown": "Тесты"} 2019-05-13 20:39:52.353636+00
104+143 6 21 \N {"markdown": "Интеграционные!"} 2019-05-13 20:40:01.990466+00
105+144 6 19 \N {"markdown": "Инновационные!"} 2019-05-13 20:40:08.21061+00
106+145 6 \N 3 {"markdown": "И сюда"} 2019-05-13 20:40:17.047374+00
107+146 6 16 \N {"markdown": "Бадумс"} 2019-05-13 20:40:24.582964+00
108+147 6 17 \N {"markdown": "Все работает? "} 2019-05-13 20:40:33.688546+00
109+148 12 \N 11 {"markdown": "Привет"} 2019-05-13 20:47:15.369318+00
110+149 6 17 \N {"markdown": "Привет!"} 2019-05-13 20:55:12.148039+00
111+150 12 \N 12 {"markdown": "пннггргрг"} 2019-05-13 20:59:00.544809+00
112+154 12 \N 11 {"markdown": "Ильяяяяяяяя"} 2019-05-13 21:02:21.115633+00
113+155 18 \N 12 {"markdown": "Привеееет"} 2019-05-13 21:16:46.458811+00
114+156 12 \N 18 {"markdown": "Привет солнце"} 2019-05-13 21:19:24.020172+00
115+157 11 \N 12 {"markdown": "ильяяяяя"} 2019-05-13 21:36:37.985452+00
116+158 11 \N 12 {"markdown": "ильяяяяя"} 2019-05-13 21:37:04.22538+00
117+159 3 \N 6 {"markdown": "Проверка связи"} 2019-05-13 21:40:41.308023+00
118+160 6 \N 3 {"markdown": "Прием-прием"} 2019-05-13 22:04:37.477219+00
119+161 3 \N 6 {"markdown": "Костя"} 2019-05-13 22:20:58.83048+00
120+162 3 \N 6 {"markdown": "Ты сделал коммит?"} 2019-05-13 22:21:14.089104+00
121+163 3 21 \N {"markdown": "Contrary to popular belief, Lorem Ipsum is not simply random text. It has roots in a piece of ."} 2019-05-13 22:24:06.104804+00
122+164 3 21 \N {"markdown": "### hellllooooo"} 2019-05-13 22:24:16.578672+00
123+\.
124+
125+
126+--
127+-- Data for Name: postElements; Type: TABLE DATA; Schema: public; Owner: qsfrneimsrtpjz
128+--
129+
130+COPY public."postElements" ("rowElementId", "rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment") FROM stdin;
131+3 0 грустно((((( \n## куда плакать \N \N \N \N
132+4 0 я из **Питера** \n_а вы????_ \N \N \N \N
133+6 0 Я написал длинный пост, а он не отправился, потому что у меня истек токен \N \N \N \N
134+8 0 Я придумал! давайте устроим бунт и уроним сервер Илья! \N \N \N \N
135+10 0 Ну сервер не вопротивился, значит можно))\nТипо для привлечения внимания\nВыглядит хначительно серьезнее)) \N \N \N \N
136+19 0 Тест! \N \N \N \N
137+23 0 Привет \N \N \N \N
138+24 0 Еще раз \N \N \N \N
139+27 0 Новый пост! \N \N \N \N
140+28 0 Всем привет \N \N \N \N
141+29 0 Привет! \N \N \N \N
142+30 0 I am back with information about _UIKit_ !\n\nThe **UIKit** framework provides the required infrastructure for your iOS or tvOS apps. It provides the window and view architecture for implementing your interface, the event handling infrastructure for delivering _Multi-Touch _and other types of input to your app, and the main run loop needed to manage interactions among the user, the system, and your app. Other features offered by the framework include animation support, document support, drawing and printing support, information about the current device, text management and display, search support, accessibility support, app extension support, and resource management.\n \N \N \N \N
143+31 0 IOS is the best!I will publish a lot of posts about it! Follow _iOS_ channel with hashtags about _Apple_, _iOS_, _UIKit_! \N \N \N \N
144+32 0 Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the\n 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book. It has survived not only five centuries, but also the leap into electronic typesetting, remaining essentially unchanged. It was popularised in the 1960s with the release of Letraset sheets containing Lorem Ipsum passages, and more recently with desktop publishing software like Aldus PageMaker including versions of Lorem Ipsum.fjedhfdjdhfdjfd \N \N \N \N
145+33 0 San Francisco journalist says police raided his home after he refused to identify source\n\n \N \N \N \N
146+34 0 It is a long established fact that a reader will be distracted by the readable content of a page when looking at its layout. The point of using Lorem Ipsum is that it has a more-or-less normal distribution of letters, as opposed to using 'Content here, content here', making it look like readable English. Many desktop publishing packages and web page editors now use Lorem Ipsum as their default model text, and a search for 'lorem ipsum' will uncover many web sites still in their infancy. Various versions have evolved over the years, sometimes by accident, sometimes on purpose (injected humour and the like). \N \N \N \N
147+35 0 приветик всем, я пишу с сайтика Кости \n\nэто так прикольноооооооооооо, я хочу смайлики(((( \N \N \N \N
148+36 0 Тоже пишу с сайта Костика! \N \N \N \N
149+37 0 # пост про веб и любовь\n\nЯ люблю веб! А вы? _??????_ Я уверена, что тоже! \N \N \N \N
150+38 0 У меня что нет постов на страничке??? Не может быть!\n \N \N \N \N
151+39 0 Я люблю сосать \N \N \N \N
152+40 0 (очень) \N \N \N \N
153+41 0 _Всем привет_!!! Как дела? _Завтра к МК_ :( \N \N \N \N
154+42 0 Привет!!!! Привет!!!! Привет!!!! Привет!!!! Привет!!!! Привет!!!! Привет!!!! Привет!!!!\n\n# не бейте меня это проверка связи\n\n> quote \n> another quote\n\n_help_\n\n\n\n\n\n\nПривет!!!! Привет!!!! Привет!!!! Привет!!!! Привет!!!! Привет!!!! Привет!!!! Привет!!!!\n\n# не бейте меня это проверка связи\n\n> quote \n> another quote\n\n_help_ \N \N \N \N
155+43 0 Куку\n \N \N \N \N
156+44 0 ) \N \N \N \N
157+45 0 # New post!\n\nThis is an example post about our _Social network_, **iOS** application! \n\nThis is a demonstration of writing a new _post_\n\n> quote can be made like this!\n\n- list\n- is something 🍀\n- like this \N \N \N \N
158+46 0 )) \N \N \N \N
159+47 0 ###### очень маленький писюн \N \N \N \N
160+48 0 hello, ilya \N \N \N \N
161+49 0 proverka \N \N \N \N
162+\.
163+
164+
165+--
166+-- Data for Name: posts; Type: TABLE DATA; Schema: public; Owner: qsfrneimsrtpjz
167+--
168+
169+COPY public.posts ("postRowId", "postRowAuthorId", "postRowUpdateTime", "postRowTags") FROM stdin;
170+3 3 2019-05-12 11:06:56.113423+00 {hse,new,tag,hello,я,ничего,не,успеваю}
171+4 3 2019-05-12 11:08:28.56758+00 {Питер,вышка,ура}
172+6 6 2019-05-12 12:41:48.579615+00 {Злюсь}
173+8 6 2019-05-12 13:13:59.958842+00 {Бунт,Бунд,Бунт}
174+10 6 2019-05-12 13:19:59.825686+00 {Бунт,Бунт," Бунт"}
175+19 6 2019-05-13 08:55:38.703923+00 {Apple}
176+23 6 2019-05-13 08:58:18.327297+00 {}
177+24 6 2019-05-13 08:58:57.09688+00 {eb}
178+27 12 2019-05-13 09:56:38.510814+00 {tag}
179+28 12 2019-05-13 10:58:05.757737+00 {ag}
180+29 6 2019-05-13 12:17:40.144256+00 {унт}
181+30 12 2019-05-13 12:31:11.967519+00 {UIKit,mobileDevelopment,iOS}
182+31 12 2019-05-13 12:33:09.981899+00 {mobileDevelopment,Swift,iOS}
183+32 12 2019-05-13 13:27:40.118674+00 {lorem,ipsum}
184+33 3 2019-05-13 18:09:10.681441+00 {привет,новый,пост,Бунт}
185+34 3 2019-05-13 18:10:26.800786+00 {tag,new,lorem}
186+35 3 2019-05-13 18:43:07.731224+00 {obileDevelopment,ышка,ello,Бунт}
187+36 12 2019-05-13 19:27:48.658511+00 {}
188+37 12 2019-05-13 19:29:45.334246+00 {web," js",webDev,kosya,ялюблюсвоюработу,веб}
189+38 12 2019-05-13 19:38:06.900945+00 {}
190+39 11 2019-05-13 20:02:49.600981+00 {}
191+40 11 2019-05-13 20:07:02.280734+00 {злюсь}
192+41 12 2019-05-13 20:52:39.125909+00 {" Бунт"}
193+42 12 2019-05-13 20:54:41.973395+00 {markdown,help}
194+43 12 2019-05-13 21:03:30.724701+00 {}
195+44 6 2019-05-13 21:24:20.968302+00 {orem}
196+45 12 2019-05-13 21:25:21.929693+00 {social_network,tag,markdown}
197+46 6 2019-05-13 21:30:40.207788+00 {lorem}
198+47 11 2019-05-13 21:58:00.669801+00 {}
199+48 3 2019-05-13 22:17:51.138898+00 {писюн,маленький,Илья}
200+49 3 2019-05-13 22:28:48.651112+00 {tags,news,hse,web,js,mobileDevelopment,work,kursach}
201+\.
202+
203+
204+--
205+-- Data for Name: quoteElements; Type: TABLE DATA; Schema: public; Owner: qsfrneimsrtpjz
206+--
207+
208+COPY public."quoteElements" ("rowElementId", "rowElementOrd", "rowElementMarkdown", "rowElementLatex", "rowElementImage", "rowElementQuote", "rowElementAttachment") FROM stdin;
209+\.
210+
211+
212+--
213+-- Data for Name: quotes; Type: TABLE DATA; Schema: public; Owner: qsfrneimsrtpjz
214+--
215+
216+COPY public.quotes ("quoteRowId", "quoteRowPostId") FROM stdin;
217+\.
218+
219+
220+--
221+-- Data for Name: tokens; Type: TABLE DATA; Schema: public; Owner: qsfrneimsrtpjz
222+--
223+
224+COPY public.tokens ("tokenUserId", "tokenValue", "tokenExpiryDate", "tokenVerificationCode", "tokenActivationTriesLeft", "tokenUserAgent", "tokenActivationCode", "tokenDeactivationCode") FROM stdin;
225+17 \\x1a0b89fca490bb64dd1526d2b833079f6954da89e14fb1635623a5800a8c31e25757d75048313d4f07547e228a8971db531faf2be52584307347828ebfc20945 2020-05-12 16:35:45.006489+00 \\xf1fbeea5b543738b22acc2673bbbfa69ea2776f46ba234f85ec251d5dc76287c6351ec553317785c5f23c5bee9c1698a42d27955c5bcaff09305b7ba0ae55310 10 okhttp \\x0b3e68e5974a5e8b29779e78332278d93b58483f5b06584a4821e1c1ea551ce13a28cd7c9e9350f96577843fe82469bc6bc1876c2ee65337025e4d79dfa7fa2d \\x0bf0c404a09f2949e9bc26765bdc0671c79865def476cbb2c39de66bcf7c5d386e26db3687ca0d493443c50fbbf68ba0ffe6864abdd3b08b00400024a7852da1
226+3 \\xd0e9cf3a38ef778783a2d6b4ecc82c30868eed82c62284ed2627eee305c7fbda649e4a40b3e911b7504e18603e8c76ba7291740f3d83200884a3c562256c252a 2020-05-12 18:36:07.869759+00 \N 10 Mac OS X — Chrome \N \\x913b36ffad3a049648705f39fee5ffebc9576ce1c59d4aac0558462325b0ef19c6ea17804cc9097af33792baa9655947ed3c275a9f84a5a5d48ab13effeded1a
227+11 \\x9fb88c39f22896feddaa5e176c6b459701d28f2fa56a83d80b0d8e9fd874618165e934468c2e6932156584daca665b3f41636e4e3dbfd4e9fd70356ede2273d4 2020-05-12 19:57:53.635167+00 \N 10 iOS \N \\xe98830312baaa841f4b7b65c799c852fc12f75dd9edecb42a304cebf2dc6ab149a56d9bdacbd16ffb94aff2c188c5af8639e8ff6b9cd18ef34e31e222c35a0a0
228+12 \\x6c3ea86a478f9f2b3caf61d8bcef018a61b954609e81fb8fdc6dccd9ebce1134e7ef922bbf89c2d274b9cc974b5552b3480042a0980571d79753dcbb143c3d2c 2020-05-12 20:08:01.486261+00 \N 10 iOS \N \\x186d1a9dbcd9e3eb35e69b1cb05309a1635d38b8350cfbfbefdc68bd3f37c11af1d9b5670d6c14827e428bcdedfb8f681d9ac3c982d08d8fb29a62f7ebaf810a
229+6 \\xe10faca3c9403b42d3e5d6ad7dad1bc95be3933b3330b94b55b6f9b6d108cfdac1288e7defbcab6b7e2a94f31756f4f217ed77ae887eac409b268388bc6724cf 2020-05-11 19:57:14.624458+00 \\x5271d7def0733e698a19f9a9378e1b54ba95a8593b2a90a3e404a465f0e8635d56c6894bca0a6eb5c49f5da10ad411e1c316068bb5eed84f4850d71a8a8faf35 10 Windows 10 — Chrome \\xdf4465993fce0f9ea7b628cd78ab65f1513ee2096139a481b35e7cecc18eacdadaa041bbd2fc5cce11a4137787645e1a6054e98da06777361882d9d952011b91 \\x03f547951f4a8eccc92891efa566f4b9f8370ab41bc428a2c78db322da07efde78b4028a2a0e76e2c92a76e29afdafd97411999fa7b57772f3f3b51fc45a4d7a
230+6 \\x6ee17d4e1b23c56f626571c1f7ebdf7f2b5b28973402d4e98e8337f43c3b1e73778580616fead50ae62233df4c9bcdcde47e635f0b62bdebd0ebbeebd1151394 2020-05-12 21:06:00.33602+00 \N 10 Windows 10 — Chrome \N \\x47015bd8699a424bd41f081dde3bd3122cf6b7b2fde87590ba0eb084196c4f693415d50d8f760af208d8313e9f3e8d8f74aa0fba35d58b6ce69a99d8e33574db
231+3 \\x4944451363b0a133b458548113ac5091a58a07de228d81e3e4c6345a2f7dec13e3d0a23336460b54991025e4888ceb721e43ca984b456ad0d7b01e5a5bb90bc0 2020-05-12 21:39:15.57724+00 \N 10 okhttp \N \\xcca681ba42dd011d288178f9034bf55a5ed4299ccbbe97383774b207f25225559f710e6e587bc8467ad6f09446f4cebca9187ea4cdb144872e6c0bf83128d50f
232+6 \\x9d74794077a85bde414f93d51c1c2ea12beb41d68ae7053efb0932a2ee0e8da694ab2ce9b4c18823a44df024b7ab7167e81188a360bd051a5f166ce1f5d34866 2020-05-11 19:57:17.459942+00 \N 10 Windows 10 — Chrome \N \\x4ee19017009b90b1d8f6e813f5fd5234d29bf0316ac7fc5dfb8504228efe3c100d5364600917dd58317a9a18ba796c3b982df4fa1dd67d9663a7960e7e4e88c4
233+6 \\x9e7d4f2869f48112728aa46b8c8b757f612b32a62c4081cfe8920977bb2cb87aa966157670fa02255c04e84c66c13eb5a86af54698ce24a2ff0a91157aaebe5c 2020-05-11 14:48:22.634562+00 \N 10 Windows 10 — Chrome \N \\x1ce4d8b76b9aa4d528eea1aabe0df7497fd156e0760d0829a30c0963ad252507f1c00a8beaed4648470deccc319caf531e98ebce0b0f653f030bc2c882d7959b
234+9 \\x8ec80e74ce3720a8028f4f4bcd9c5598ca0343afd63cff5a8933729b1e2e28ca5e1a761420ae898ca51080b8e431ac1eaa5936dcdfaa4a04eeefe016adcdf86a 2020-05-11 15:36:57.456372+00 \\x2c1efa77bd7c3f09179efa261bb10ada6b6b2bdc2aa52f4f7f3f75de3093c0c80afedb8e09441b6fe683e73cd4e28dcdab78cc3d6d8c667c9ce8abb8c7f062d6 10 iOS \\xf0beaa45dc5b744d1691c0db6389a21e350280c8023a211adb45bcd62328312b89f663fb17452cb1708559eea67895e3d25d55422911053f4b4bb38206f88883 \\x10e95dd6f45681fe8b55e5f43905738a4b2bf49b8b119b559d8aa33090d1141a4071fc67eab7f9426b1932d5674e6690d2b3cd059c12f9b8fdef51f13e708cee
235+12 \\x7f76401afb1167a59d1aadf3b051900498332e56a909927f004073f676253b65fe8c75860ce8635d7d2e72aeb25f405db4c814304f4ac5120d83d51b8de24e3e 2020-05-12 09:44:34.181474+00 \N 10 iOS \N \\xd7132d27c779f16cb32eab613c3716f0436348833fca1ff8ed45a27121a2bd4c6ad4c7cbfaceb588b801708d45bcc578a3dbc19730392fe661d2a37aac086c7e
236+10 \\xfca54c43c5e2a8e6853d48325cb700a7f50ecbe635fd0a5353a36ea7858ba904a9c712c6a7d2d6e6e8d20aa3aae9f326c0fbe7d8c96f6357295012f5898bea84 2020-05-11 15:52:01.741885+00 \\x3f1fcbaba55307ac237249c0a17d1d2747dfccec6338be65fbefee8b01466f9515c376cedb6951b35a0b286d793284d4277e9e556406f26daae0af69d3362ff9 10 curl \\x2005dda2be269b6d23c185e0418200f42a17e0ac5b94e8a2a76753470128b1fa2da58b434fa15c2b68228b3212d775fe7a92bf0cb4d4d7dcf1377ed43eb16429 \\x26633323ef3a3c83ff8f4051ebe3d53778a0372534c8bdccfa0538309ee2b545e4baf9f07dfa1ec1728e4ddb95597d033370633a8fab70fc328b2c3932dbfc00
237+12 \\x3e81a2f178cc25b8280ef5bca9fee6f71e81f00e997a14810d7b6059ed638047aa55c06d9d51aef7eb1732de963ea12a7e12bd3864a3b05f696663f9129c6088 2020-05-12 09:58:42.998106+00 \N 10 iOS \N \\x0dc1c1286c3bc853f69ceb5f03dc0480187bd0acb089be8f1aa61dc51d68198cfc017d82ad3c2713e8c67b30e8cfaa81d87969744e231670fc3118a38d89714c
238+12 \\x25db505e0f4bc136b75ec2ef96132868d31baf8b659ccd89f797ac6d4a6375fa713506a9434d5a4c5f4d6b2663d31dcb6478e3eb92520c9201d6728c315e1424 2020-05-12 10:01:45.081199+00 \\x4c05612fff5c714d46abf6098a308744205ed345003b74d21f9e19622a9544ad5d186f1a84345d2d91dbd1d3a53e0d05461f66439f6b21a7c1c76b483a7b3641 10 iOS \\x7ebe3eb07ebf2ac66cab89a5fa26f8acc53f3ec06df7bad7522ff58ed5d02086c7f48687bea499b7ce47c04c79245cd06c0c56910f38d9f2b1af265b8de4775b \\x0a9df3cdc3b1a21eac72e3d77971ada874c899ac14937cb454a1e5c781b1886cfbb8822fb829273da5580ba2b15db947082463cbb36bb050445ea27b15d366a0
239+12 \\x3f0a881a910c85ea7dfd6ede9f732427bdf08e62b3dd19eb060d4536bf14e153a5804b86a16a61235c22d78dbac959b4fbb8b013d18c656c3d0faa6819727b8c 2020-05-12 10:02:27.63402+00 \N 10 iOS \N \\x9581a372265f20f5f51259f89d471e4e14aefe32989f17548832f3a31ec046ce93cc244885c2b7ea607a39249a14643d45b736ad5e786886c9cc2aaf86f89475
240+12 \\x12e21098059ff5efe4957f54e542fb0d03162f6a1dbdf4881f3d0915afc0e85ac2f29f75a99f706928ba57e77c1ab3b4f6563e4bc740f8dc06589b63774cdc85 2020-05-12 10:56:28.957574+00 \N 10 Mac OS X — Chrome \N \\xa61575d8f89b31a6e6ff558c72befaddea92294797433da8cee0d8238953541bf6fe9603f1d9f08fbf1eb094c34ce51de8c20ceb2a0e4704a57473eb6a2d8047
241+12 \\x239fc16e587f11903a0b983e3e9cc10ce5f9e320b753831190d03f647c55e00ca7f4635211c187a082d827fa5e8c038e40ab0cce47e68ec5a13ab56bc2886259 2020-05-12 19:26:46.204018+00 \\xa0dfb4c9699729277c23f492064763c2dc6496cf8f3c0805b374cffb38eec1f12f3df0c033b832db025a6f5a9deb7d6282fb72526a9e1a55876300848aede8ca 10 Mac OS X — Chrome \\x55224d5b28d6fa16e692740d8639eb033d142ed1a77ca0e50912acb4c952c9dccbc3616bc6454caebed3f1dbc3a5d5d9b939c7b8956a22b9fbefc3763d1916a0 \\x409a3cfd6904ec3c12b4dd33632040e89f4f340fe90e9b75abb76a787b58311f090204fd718b22e5cf9f6438e1f7984f335142624260f5d0248494ca96ba02b7
242+11 \\x41da42b65822526a52dec3f651a6d432fa950ddc795fd0a582b5b722b4c6e4956292b329dd58b4471a270a9784e9542f63142d799af8e6c96679e8bd86171835 2020-05-12 20:06:05.904528+00 \N 10 Mac OS X — Chrome \N \\xd2af034090688a7c03b7492d69c4bfeacbdf0b9e68be7bd3cc45182a689300dd3c5bb34e38d7e6152057e169b99fc6118cd876ed9987d7ae0e7a69f2dbd82c5c
243+12 \\x065e8193c701d5e8600eb30f3632845d8ac76f59b81155f88f520ff179bf13a3867e3363fb2589ca93ef438187c1cd990abd3ddd5e126fa722bbe727c13e9348 2020-05-12 20:45:55.846716+00 \N 10 iOS \N \\x52274795f5999d01a681f51a5e29afe4edd26889ddaaa77d1d2a85a2bfd08be4af9253d356bb360822034a5171819562177c3cea0e7df6e71212f672fee86f53
244+18 \\x897a5aa341b7709c7d9cb58f425723458658a1570a26429976b3c92c0da1613fa7e27fbe4a8429b5ab3d4cf2938caf1d730e57911a8b51b2d4f17257473bbd69 2020-05-12 21:13:54.40466+00 \N 10 Mac OS X — Chrome \N \\xcae63685d7a24031e550c5e49ac1e8ed8bd3b3bfff51051977c0c2cceba8af2a01faa964cebdac5724c8f0be7ce19f8af7902f6710bb8e989ce35c93833fc9fa
245+6 \\x6963dfdbf872528ed1f985e4d788cac5b96a9afc5c9e1aa78073e8fca1505a201b459695d3c5dbf8123b8f80f35b7672990389ce26be1bf6873c3fe59f4757ee 2020-05-12 12:37:07.199628+00 \N 10 Windows 10 — Chrome \N \\x766516d234fb7cabb224fbd991193784a60d62106e5d4b7ceeb7bdf123d7504a35ca9db3c1e14aacd3bd060c98b3e4e5e4f6bc7e0ee61440437c6464a63eb596
246+6 \\xef2cec0fe597a7158618a567da72595f81324e5ab42df9ee6f17024f9937267e1b6da7aada49defa7f2938b9e9584aed098087da4796c966fabeaff348d4e5c6 2020-05-12 12:37:55.467622+00 \N 10 Windows 10 — Chrome \N \\xc0d6f362c33fc9d3d2e61fef09eed321c7845968e4bd1ae17ddb61128c59861f25db12ac030c5f1871725be3d73e5e68f8ae64a29284cd07a8e1aa693beddf22
247+6 \\xf26ebf4f5880219a2fc8ae8624adcf8727a3ecd3521f396c811a90ca6ea7c15788b97145e33d6ee6bad7aefca1d53d51c852a4fd951b7204d6ef50b38b3305c6 2020-05-12 12:46:13.117509+00 \N 10 Windows 10 — Chrome \N \\x8e0519e8f56e7a4bbab46b58ff498e87a733e6371cd647c597551ad151b3a63c3be4e733d2130bf568a01e59f79c01bf9b38ed6a96940746f8f12ea009019ed3
248+6 \\x8b48c76b4d6005bf0c02ba7a7b765b6372246e1a7d503b249e901e6ddbade8e1f660272595de6b876afb945cb93cd9e03ab3b0498016e0285864acdb4d1ed228 2020-05-12 12:47:57.324299+00 \N 10 Windows 10 — Chrome \N \\xd89f6f8f5c3b9d6c66639febb0d2208023f46851bd402fffb2f86a05684bbde9f2964fdf443405fbf637d51257040e46971194f984927b1801635281497f93b6
249+6 \\x89fcb726e07982cd2ad61504ed85d2f6ab390108b501ce9533900cc232434409f7c37d66a64fdc48a3b145f110412290bf440d69b3360b323ba9138358d47432 2020-05-12 12:48:18.89163+00 \N 10 Windows 10 — Chrome \N \\x8d1344a463e9a6f3f5a334e5bccd532e3d42aed478808c46d0ebf711fcb6eb7e40890b04d713c6d5636e0ac1596c887771100e52b9619cb7aba344119b2adf15
250+6 \\x2a4e2f5621af53d8aca32b0e6ef9f784661e0d25e9f3c1a6147da28c8ec582b86c1edfd9ad50672156c5b8956eab0f4039ef9f5194c078ae09b6b908997cb828 2020-05-12 12:58:03.390233+00 \N 10 Windows 10 — Chrome \N \\xa0fa6918589bee447fa3d63548390836d95571cf94e4056e4cd51cab5f5cdad579774c55385173893bb5cf8f7123ea123fa8de7d6c1fd22bb07fae05eb82c470
251+6 \\xe79fbed1a6a85dca69674ce3c8f0d04087e3ca08e61a1e6570402405f56f6d7e1ff405c345027645636799e3b67ff432d3885e8f87fd9f37dcbdd509264ab4c9 2020-05-12 13:02:15.709627+00 \N 10 Windows 10 — Chrome \N \\xf39f55f18841a4c029d2721dd911e07738011cc0043b783c615d6f68238b60ddc3fc9f13e0f93ca918a81b274c86c6c412b0d1d5d283eea26e5d331ab4eceb63
252+6 \\x791f98bdab86f17dc631d8a641308babd1bf6a6d80c8d9a13474847b5bdd403a07ceda5bfda647ceeea52cc15d24dcb84417c3900f7744d548f3c11c4927a636 2020-05-12 13:00:39.90702+00 \N 10 Windows 10 — Chrome \N \\x54277fb3f03893ee8ca550f6cfd7b2cf03f792ee987dae7a36ecb6b052f5bc46d1262eabc34e2ee6d896f3ba50a9c309cba785ed55928866b1f4d1217e5d62fe
253+6 \\x8475047b3f4cf52c58d31b5f40f51fbcb421e889b9545af40685b50f77c32060c08adb7593733d174d0d705e7a11b05352745f997e151383c3df4087b87aa437 2020-05-12 13:08:36.061589+00 \N 10 Windows 10 — Chrome \N \\x32b6441572986f12c92b4cab97231ed416b0c1538589061bc1498af55b12d6abf16ba10842c97f950ace47bd6a34499a458112de353e003336eaefd87232a441
254+6 \\xe50a1cabdbce47cd7384ea7e7b9a4ebd1f70bd4d2270f7fd1449243e3c2a514f6374a9415b838a88d44be91260b1c8e789c02451a5215caa823e85ce9a6c6a35 2020-05-12 13:11:01.163827+00 \N 10 Windows 10 — Chrome \N \\x4cc5ab60a8b31de5109f9f0f86754e5654aecc8a83b5c553854809690a576d94d71f474d776d490828522db88349c607968d120af014bebdfcc984ff11ec97f3
255+6 \\x14ecc52de16df124a0cfdd6fac2af58998d7ef75a4b77dc6ffcbebfcb1a0641933125399ccb83ff162b5a4c526cae43989c73db33f5f4e9cd0d667ffa64b1491 2020-05-12 13:15:09.286079+00 \\xa3c9a1ed5ad4cf49cc0d90f9e0f179975cddab69f2306e205a35f1a4daac65dc75cd5182de269d7b1b4f21e6de154279363c31ff7807ee0998e54cc408c542a4 10 Windows 10 — Opera \\x53b20233e1912eb3e1889f7d62813852a6f00160c923640e0500b3c8056c0e1582cc6ab1f0860c9ea377b7bc057cabc8d1107bfd09a4e1de1a5200facc9e4680 \\x976304336533e75ebd013d336daaec896ea6aac620ba76593cf0f5e9067bbcbd7c22db86c9cf570e555a7d3d38840dea671897363c5de797628db25819cea194
256+12 \\x9a3f1bc8ad7af3256544d16b10af39f170671b37913ad0795b7c83b92c165815d52e04ae41a778ba1987ceb7ec3771a8a96c2117b1a93e53086a7aa72b744101 2020-05-12 13:17:22.323574+00 \\x68614722f437fd805c9bef73e1319a60ab7ae8d1e669afe8a52c7853d19da646dbd72ad8026329c2555c0b5e5ad4f16793b0a0b55e33f5ca97b941b4d28a03ae 10 Mac OS X — Chrome \\x03906cccc155cfe4ef4b237e7663f05616623b7a10c2443248f79f3ff9fd3df9c4052107b11e3426a66427b7a22c1205ef6b6b8eaa366500f4ed775281a44bb9 \\x1d33623701873d27f030afc04b3af27554adde549230e814b1791c9104591ca1751e865c89591b689df1e02ffbdfe279fccfd59335d448313a6c7b0c6db34818
257+12 \\xdb2021edc253bfdf75870708682c0b17c60d9d2552d614da87874341127549d811b49b331f66902e583937282f8b433b64111a28647447bac45457fbc4951397 2020-05-12 13:17:25.803874+00 \N 9 Mac OS X — Chrome \N \\x404618e3db88af5f6f48d97526ba2d813ae4cd98943892a3eb33d606182a4c685d1f251c577894aa2d6f192446e6c377250c0f1c199eaae0164e6908921d56d3
258+6 \\xff236155bcdc965d10d97e37b95498cd48e84f91d84cbf9eeb7149d4488174d0c011ebcec15a708775fc02eb48d987c6a707460cf3f4ad6a5920acfa25e4097d 2020-05-12 13:20:49.70022+00 \N 10 Windows 10 — Chrome \N \\xac51b5e531a71c2b90024e308ded6bcf291327ccf58c2a38a79e93cd21aef908469e3ba731d438df0dd830bd9e91a3b4af8baefcf1481539face9f7bd284dc63
259+6 \\xd8068bbf1c75403f98bc65d5b5023773391eb157e71b1796d5ef8ff6e51e12dfa8eee816dd387a8284e62abf3622bdd62e986ab70d4e7c06eadf0c336c7ddf65 2020-05-12 13:42:52.574211+00 \N 10 Windows 10 — Chrome \N \\xfe79ff74735cb836511460da0b64387353ac5d1328f8c429312e09ad27d7d76344ff0ff760beca020bcc651ce6e2014049836bdf8fd2e0b79c752bb58a44edd2
260+6 \\x4054af8d092a164806b1f5c1a9272fef54d04b14fea1c5c7e1cdbb82541339198bb449f10aeaa6c729b5d60b72201230ccf2cc023d4457cc7990b37b74c53680 2020-05-12 13:43:48.856981+00 \N 10 Windows 10 — Opera \N \\x34cf5f64da39a5f9348f024fe04ca22c0f71b85fe3e1538474d1605aef8e65e0dd6b01a31dbb5a6ca5d957edfc746e395a40832406cf6fe3b4bf6f9d67f6d2b1
261+6 \\xca1eaaff2de79c350e2b452a8adac5d465def68a81b2cae0ce6c6ab06b79fb862594b8557b3d45da17ad2ec2d6cdb19792f6168be7513f30afd709a04bf4a045 2020-05-12 14:12:24.590032+00 \N 10 Windows 10 — Chrome \N \\x3099f74e612c1ef8b65d742748232025bdb7c6e54dbcdca70ff015b3f6ed1ed9b6b8b03e5a9cefe80a81598b40e8603ac8d643a4728904a96f8283b4132a670b
262+12 \\xe9135b7110691c01639db7fe5828c1bbb1fda424d4eb4ede378413493742ef360af3fd97b71f2a99977222725d9e22c8eef62e89331ae2dd269678d8549c44f7 2020-05-12 17:39:51.225664+00 \N 10 iOS \N \\x78ccada9b2d8e9a7aa553ad2d1143eff23b8b59caaf3e573cfb115bd66aa2c2d3735fab6bee8fe0c83bc00148129793b806824c2901adc73665841f88b8f15f0
263+12 \\x4b61df40968e85661eb637ede9aa49bedb12eb9fbaad1250317f102390ae474bc9fc6e49e9f06b61a9b2f79eb9a72c59d0178080d4699abae2b3406bd3702fd0 2020-05-12 19:26:49.449533+00 \N 10 Mac OS X — Chrome \N \\xfc0df82243a1174a1c60f066369a22fb75c516e071061dbc539a61cee7853b081dfdb0e6ef05f85cf6a70d9a6a184daa2f8d46de41ae5aab95c0f0f553875411
264+6 \\x2d1108aa6559686f85b32cb0ed446d42c64021ff43539b4e4462b697dcf2ec1c6c6c306100be9aee0e1321dac27a5dcee76a34abcfda77a7949b01e64a6acdb6 2020-05-12 14:22:04.298934+00 \N 10 Windows 10 — Chrome \N \\x347810d21c6b1c39fc8deb5056df65f5aff393a8b94b4f9fc80064a5d4e3b98d3b6de9ea8e2fcc0625ede95a3cf94f707c490710da086d6dfe645f6bc498d814
265+11 \\xd0c382a30c6508107c4095fbe6713c8b987d51145e5e95b25fe082d00c89af26c9d4f46b5c6a9a63bbc82a63a57c9c0d488cb6787f64465a0b29dbe4b481aec1 2020-05-12 20:06:08.427816+00 \N 10 Mac OS X — Chrome \N \\xc7d039fa0c13356ffd1379a8ec10a97b3bbfafb0a3222aaabff85c5467ffb8224bbf1e450aafd278642aa457db904d4318d05a37a3ad65b6e42055729baa992c
266+6 \\x783d36a882b22f9e35e0e67f16058bb01d07bbaee4f35465f84125868367161aa77a48c24fce9a8587ab5baeaefc7f20d2d1fbe6b9ffc3e7ea079ce4b4fc2065 2020-05-12 21:05:34.945924+00 \\xaed141900570ffbc6027328ebaedc19516014fd15e51f2dac2f63d0ebdcc0b6e42893be3ad9edca85b521412357bb0e2ec74eb359af17b6d7d5bbac9b59912e4 10 Windows 10 — Chrome \\xa17c601d49975527b36bdeccfedca7f66bbc0603ed8456fe99c8592e270f070ab15dd083efc278665c295af2667b345c24f1da9d1d19299bbd001971b4e3f112 \\xe887bda8dc9e076244c88d678885f81b21b93d228fe24cd0f8619203671e40e0db8d4f50168083f1742809cb75338ddc62c08ba017790ea6f15602ef2fa77fac
267+11 \\x467a1e43d01b6d92be00e984d74d2984225cead7380ddba3a3b962b64fa7c99878cfda33c15bc72826fd4d747c05b1905a51fcecd7bdc2c20322c1c9c0cde1b8 2020-05-12 21:35:38.166955+00 \N 10 Mac OS X — Chrome \N \\xab87612391d51e870bce7b33ed618fbc1310cf2bfffe7cb8a887a161a107187924848e0f9aab60fd2719155984a800181a4d1dc7b58680da197b2b1e373df210
268+\.
269+
270+
271+--
272+-- Data for Name: users; Type: TABLE DATA; Schema: public; Owner: qsfrneimsrtpjz
273+--
274+
275+COPY public.users ("userRowId", "userRowFirstName", "userRowMiddleName", "userRowLastName", "userRowFacultyUrl", "userRowEmail", "userRowIsValidated") FROM stdin;
276+12 Дарья Юрьевна Редникина strategy.hse.ru/ dyurednikina@edu.hse.ru t
277+18 Darya _ _ cs.hse.ru/dse/ rednikina.com@yandex.ru t
278+6 Костя Игоревич Манежин perm.hse.ru/sgf/hum/ kimanezhin@edu.hse.ru t
279+11 Костюченко Игоревич Илья spb.hse.ru/fmcs/math/ iikostyuchenko@edu.hse.ru t
280+3 Анна Денисовна Михалева spb.hse.ru/humart/design/ admikhaleva@edu.hse.ru t
281+9 Darya Yuryevna Rednikina cs.hse.ru/dse/ dyrednikina@edu.hse.ru f
282+17 anna denisovna mikhaleva scem.spb.hse.ru/man/ hello@edu.hse.ru f
283+10 Seva Algebrovich Leonidov cs.hse.ru/dse/ iikostyuchen@edu.hse.ru f
284+\.
285+
286+
287+--
288+-- Name: channels_namedChannelFullId_seq; Type: SEQUENCE SET; Schema: public; Owner: qsfrneimsrtpjz
289+--
290+
291+SELECT pg_catalog.setval('public."channels_namedChannelFullId_seq"', 37, true);
292+
293+
294+--
295+-- Name: groupChats_groupChatId_seq; Type: SEQUENCE SET; Schema: public; Owner: qsfrneimsrtpjz
296+--
297+
298+SELECT pg_catalog.setval('public."groupChats_groupChatId_seq"', 24, true);
299+
300+
301+--
302+-- Name: messages_messageStorageId_seq; Type: SEQUENCE SET; Schema: public; Owner: qsfrneimsrtpjz
303+--
304+
305+SELECT pg_catalog.setval('public."messages_messageStorageId_seq"', 164, true);
306+
307+
308+--
309+-- Name: posts_postRowId_seq; Type: SEQUENCE SET; Schema: public; Owner: qsfrneimsrtpjz
310+--
311+
312+SELECT pg_catalog.setval('public."posts_postRowId_seq"', 49, true);
313+
314+
315+--
316+-- Name: quotes_quoteRowId_seq; Type: SEQUENCE SET; Schema: public; Owner: qsfrneimsrtpjz
317+--
318+
319+SELECT pg_catalog.setval('public."quotes_quoteRowId_seq"', 1, false);
320+
321+
322+--
323+-- Name: users_userRowId_seq; Type: SEQUENCE SET; Schema: public; Owner: qsfrneimsrtpjz
324+--
325+
326+SELECT pg_catalog.setval('public."users_userRowId_seq"', 18, true);
327+
328+
329+--
330+-- Name: channels pk_channels; Type: CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
331+--
332+
333+ALTER TABLE ONLY public.channels
334+ ADD CONSTRAINT pk_channels PRIMARY KEY ("namedChannelFullId");
335+
336+
337+--
338+-- Name: faculties pk_faculties; Type: CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
339+--
340+
341+ALTER TABLE ONLY public.faculties
342+ ADD CONSTRAINT pk_faculties PRIMARY KEY ("facultyUrl");
343+
344+
345+--
346+-- Name: groupChats pk_group_chats; Type: CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
347+--
348+
349+ALTER TABLE ONLY public."groupChats"
350+ ADD CONSTRAINT pk_group_chats PRIMARY KEY ("groupChatId");
351+
352+
353+--
354+-- Name: messages pk_messages; Type: CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
355+--
356+
357+ALTER TABLE ONLY public.messages
358+ ADD CONSTRAINT pk_messages PRIMARY KEY ("messageStorageId");
359+
360+
361+--
362+-- Name: quotes pk_post_quotes; Type: CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
363+--
364+
365+ALTER TABLE ONLY public.quotes
366+ ADD CONSTRAINT pk_post_quotes PRIMARY KEY ("quoteRowId");
367+
368+
369+--
370+-- Name: posts pk_posts; Type: CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
371+--
372+
373+ALTER TABLE ONLY public.posts
374+ ADD CONSTRAINT pk_posts PRIMARY KEY ("postRowId");
375+
376+
377+--
378+-- Name: users pk_users; Type: CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
379+--
380+
381+ALTER TABLE ONLY public.users
382+ ADD CONSTRAINT pk_users PRIMARY KEY ("userRowId");
383+
384+
385+--
386+-- Name: users user_email; Type: CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
387+--
388+
389+ALTER TABLE ONLY public.users
390+ ADD CONSTRAINT user_email UNIQUE ("userRowEmail");
391+
392+
393+--
394+-- Name: posts fk_author_id; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
395+--
396+
397+ALTER TABLE ONLY public.posts
398+ ADD CONSTRAINT fk_author_id FOREIGN KEY ("postRowAuthorId") REFERENCES public.users("userRowId") ON UPDATE CASCADE ON DELETE CASCADE;
399+
400+
401+--
402+-- Name: channels fk_channels_users_id; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
403+--
404+
405+ALTER TABLE ONLY public.channels
406+ ADD CONSTRAINT fk_channels_users_id FOREIGN KEY ("namedChannelFullOwner") REFERENCES public.users("userRowId") ON UPDATE CASCADE ON DELETE CASCADE;
407+
408+
409+--
410+-- Name: messages fk_messages_author; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
411+--
412+
413+ALTER TABLE ONLY public.messages
414+ ADD CONSTRAINT fk_messages_author FOREIGN KEY ("messageStorageAuthorId") REFERENCES public.users("userRowId") ON UPDATE CASCADE ON DELETE CASCADE;
415+
416+
417+--
418+-- Name: messages fk_messages_group; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
419+--
420+
421+ALTER TABLE ONLY public.messages
422+ ADD CONSTRAINT fk_messages_group FOREIGN KEY ("messageStorageDestinationGroupId") REFERENCES public."groupChats"("groupChatId") ON UPDATE CASCADE ON DELETE CASCADE;
423+
424+
425+--
426+-- Name: messages fk_messages_to_user; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
427+--
428+
429+ALTER TABLE ONLY public.messages
430+ ADD CONSTRAINT fk_messages_to_user FOREIGN KEY ("messageStorageDestinationUserId") REFERENCES public.users("userRowId") ON UPDATE CASCADE ON DELETE CASCADE;
431+
432+
433+--
434+-- Name: postElements fk_post_quote_id; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
435+--
436+
437+ALTER TABLE ONLY public."postElements"
438+ ADD CONSTRAINT fk_post_quote_id FOREIGN KEY ("rowElementQuote") REFERENCES public.quotes("quoteRowId") ON UPDATE CASCADE ON DELETE CASCADE;
439+
440+
441+--
442+-- Name: postElements fk_post_quote_self_id; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
443+--
444+
445+ALTER TABLE ONLY public."postElements"
446+ ADD CONSTRAINT fk_post_quote_self_id FOREIGN KEY ("rowElementId") REFERENCES public.posts("postRowId") ON UPDATE CASCADE ON DELETE CASCADE;
447+
448+
449+--
450+-- Name: quotes fk_quote_post_id; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
451+--
452+
453+ALTER TABLE ONLY public.quotes
454+ ADD CONSTRAINT fk_quote_post_id FOREIGN KEY ("quoteRowPostId") REFERENCES public.posts("postRowId") ON UPDATE CASCADE ON DELETE CASCADE;
455+
456+
457+--
458+-- Name: quoteElements fk_quote_quote_id; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
459+--
460+
461+ALTER TABLE ONLY public."quoteElements"
462+ ADD CONSTRAINT fk_quote_quote_id FOREIGN KEY ("rowElementQuote") REFERENCES public.quotes("quoteRowId") ON UPDATE CASCADE ON DELETE CASCADE;
463+
464+
465+--
466+-- Name: quoteElements fk_quotes_quote_self_id; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
467+--
468+
469+ALTER TABLE ONLY public."quoteElements"
470+ ADD CONSTRAINT fk_quotes_quote_self_id FOREIGN KEY ("rowElementId") REFERENCES public.quotes("quoteRowId") ON UPDATE CASCADE ON DELETE CASCADE;
471+
472+
473+--
474+-- Name: users fk_user_faculty; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
475+--
476+
477+ALTER TABLE ONLY public.users
478+ ADD CONSTRAINT fk_user_faculty FOREIGN KEY ("userRowFacultyUrl") REFERENCES public.faculties("facultyUrl") ON UPDATE CASCADE ON DELETE RESTRICT;
479+
480+
481+--
482+-- Name: tokens fk_user_token; Type: FK CONSTRAINT; Schema: public; Owner: qsfrneimsrtpjz
483+--
484+
485+ALTER TABLE ONLY public.tokens
486+ ADD CONSTRAINT fk_user_token FOREIGN KEY ("tokenUserId") REFERENCES public.users("userRowId") ON UPDATE CASCADE ON DELETE CASCADE;
487+
488+
489+--
490+-- Name: LANGUAGE plpgsql; Type: ACL; Schema: -; Owner: postgres
491+--
492+
493+GRANT ALL ON LANGUAGE plpgsql TO qsfrneimsrtpjz;
494+
495+
496+--
497+-- PostgreSQL database dump complete
498+--
499+
stack.yaml−1
@@ -40,7 +40,6 @@ packages:
40extra-deps:
40extra-deps:
41- taggy-0.2.1
41- taggy-0.2.1
42- crypto-rng-0.1.0.2
42- crypto-rng-0.1.0.2
43−- periodic-0.1.0.0
44# - servant-options-0.1.0.0
43# - servant-options-0.1.0.0
45
44
46
45