a26805f...master · denis

git.iko.soy/denis

on master help sign in

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>

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

28- aeson

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

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 ,

6 TypeApplications ,

7 TypeOperators,

8− OverloadedStrings #-}

8+ OverloadedStrings,

9+ RecordWildCards #-}

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

26-- MARK: Documentation

28-- MARK: Documentation

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

33type AnonymousChannelId = Int64

39type AnonymousChannelId = Int64

@@ -46,10 +52,10 @@ instance ToJSON AnonymousChannel where

46 "people" .= cPeople ]

52 "people" .= cPeople ]

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

55−

61+

denis/src/Data/Channel/NamedChannel.hs+20−11

@@ -5,7 +5,8 @@ OverloadedLabels,

5OverloadedStrings ,

6TypeApplications ,

7TypeOperators,

8−OverloadedStrings #-}

8+OverloadedStrings,

9+RecordWildCards #-}

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

27-- MARK: Documentation

31-- MARK: Documentation

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)]

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

38type NamedChannelId = Int64

47type NamedChannelId = Int64

@@ -53,14 +62,14 @@ instance (ToJSON u) => ToJSON (NamedChannel u) where

53 "people" .= cPeople ]

62 "people" .= cPeople ]

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

33type StaticPQ = PoolPQ Schema Handler

35+printRed :: (Show a) => a -> IO ()

36+printRed a = do

37+ putStr "\a\x001b[31m"

38+ print a

39+ putStr "\x001b[0m"

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

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/GroupChat.hs+10−1

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

7 TypeOperators,

8 OverloadedStrings,

9 TypeSynonymInstances,

10− FlexibleInstances #-}

10+ FlexibleInstances,

11+ RecordWildCards #-}

11{-# OPTIONS_GHC -Wno-orphans #-}

12{-# OPTIONS_GHC -Wno-orphans #-}

@@ -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

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"]

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)]

denis/src/Data/Limits.hsnew file+35

@@ -0,0 +1,35 @@

1+{-# OPTIONS_GHC -Wno-missing-export-lists #-}

3+module Data.Limits where

5+import Data.Int (Int64)

7+maxChannelName :: Int

8+maxChannelName = 60

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 ,

7 TypeOperators,

8 OverloadedStrings,

9− TupleSections #-}

9+ TupleSections,

10+ RecordWildCards #-}

10{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}

11{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}

@@ -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

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]

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

48data MessageDetination = GroupChatDestination GroupChatId | UserChatDestination UserId

56data MessageDetination = GroupChatDestination GroupChatId | UserChatDestination UserId

@@ -81,10 +89,10 @@ instance FromJSON Message where

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

@@ -97,17 +105,18 @@ infixl 4 <>>

97f <>> a = f <*> pure a

105f <>> a = f <*> pure a

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

30import Data.Time.Calendar

31import qualified Data.Vector as V

32+import Data.Tags.Validation

33+import Data.Text.Validator

33-- MARK: Documentation

35-- MARK: Documentation

@@ -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"])]

44+instance HasValidatableText PostCreation where

45+ validateText (PostCreation body tags) = all validateText body && all (validateText . (~= validateTag')) tags

43-- MARK: Actual type

47-- MARK: Actual type

denis/src/Data/PostElement.hs+23−6

@@ -15,16 +15,20 @@ module Data.PostElement (

15 MkElementRow,

16 PostElementRow(..),

17 PostElement(..),

18− elementsToRows

18+ elementsToRows,

19+ PostQuote(..),

20+ stripPostElement

19) where

21) where

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

29-- MARK: Documentation

33-- MARK: Documentation

@@ -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 ]

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+

38-- MARK: PostElement

49-- MARK: PostElement

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

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)

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+309−50

@@ -9,7 +9,8 @@

9 FlexibleInstances,

10 KindSignatures,

11 DeriveAnyClass,

12− RecordWildCards #-}

12+ RecordWildCards,

13+ ScopedTypeVariables #-}

14{-# OPTIONS_GHC -Wno-partial-type-signatures #-}

15{-# OPTIONS_GHC -Wno-partial-type-signatures #-}

@@ -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

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

113

100-- MARK: Documentation

114-- MARK: Documentation

101

115

@@ -283,12 +297,40 @@ getChannelForUserQ = selectStar $

283 from (table #channels) &

297 from (table #channels) &

284 where_ (#namedChannelFullOwner .== param @1 .&& #namedChannelFullId .== param @2)

298 where_ (#namedChannelFullOwner .== param @1 .&& #namedChannelFullId .== param @2)

285

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+

286getAllChannelsForUserQ :: Query Schema (TuplePG (Only UserId)) (RowPG NamedChannelFull)

312getAllChannelsForUserQ :: Query Schema (TuplePG (Only UserId)) (RowPG NamedChannelFull)

287getAllChannelsForUserQ = selectStar $

313getAllChannelsForUserQ = selectStar $

288 from (table #channels) &

314 from (table #channels) &

289 where_ (#namedChannelFullOwner .== param @1) &

315 where_ (#namedChannelFullOwner .== param @1) &

290 orderBy [#namedChannelFullId & Desc]

316 orderBy [#namedChannelFullId & Desc]

291

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+

292updateFacultyQ :: Manipulation Schema (TuplePG Faculty) '[]

334updateFacultyQ :: Manipulation Schema (TuplePG Faculty) '[]

293updateFacultyQ = insertRow #faculties

335updateFacultyQ = insertRow #faculties

294 (

336 (

@@ -319,6 +361,11 @@ createNamedChannelQ = insertRow #channels

319 OnConflictDoRaise

361 OnConflictDoRaise

320 (Returning $ #namedChannelFullId `as` #fromOnly)

362 (Returning $ #namedChannelFullId `as` #fromOnly)

321

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+

322deleteNamedChannelQ :: Manipulation Schema (TuplePG (Only NamedChannelId)) '[]

369deleteNamedChannelQ :: Manipulation Schema (TuplePG (Only NamedChannelId)) '[]

323deleteNamedChannelQ = deleteFrom_ #channels (#namedChannelFullId .== param @1)

370deleteNamedChannelQ = deleteFrom_ #channels (#namedChannelFullId .== param @1)

324

371

@@ -351,7 +398,7 @@ getChannelPostsQ lim dir uIds tags = getLastPostsQ

351 Just uIdsQ -> (`in_` uIdsQ)

398 Just uIdsQ -> (`in_` uIdsQ)

352 Nothing -> const $ false

399 Nothing -> const $ false

353

400

354−getTagsQ :: Query Schema '[] (RowPG (Only String))

401+getTagsQ :: Query Schema params (RowPG (Only String))

355getTagsQ = selectDistinct (unsafeFunction "unnest" #postRowTags `as` #fromOnly) $

402getTagsQ = selectDistinct (unsafeFunction "unnest" #postRowTags `as` #fromOnly) $

356 from (table #posts)

403 from (table #posts)

357

404

@@ -362,15 +409,26 @@ createMessageQ :: Manipulation

362createMessageQ = insertRow #messages

409createMessageQ = insertRow #messages

363 (

410 (

364 Default `as` #messageStorageId :*

411 Default `as` #messageStorageId :*

365− Set (param @1) `as` #messageStorageAuthorId :*

412+ Set (notNull $ param @1) `as` #messageStorageAuthorId :*

366 Set (param @2) `as` #messageStorageDestinationGroupId :*

413 Set (param @2) `as` #messageStorageDestinationGroupId :*

367 Set (param @3) `as` #messageStorageDestinationUserId :*

414 Set (param @3) `as` #messageStorageDestinationUserId :*

368− Set (param @4) `as` #messageStorageBody :*

415+ Set (notNull $ param @4) `as` #messageStorageBody :*

369 Set currentTimestamp `as` #messageStorageTime

416 Set currentTimestamp `as` #messageStorageTime

370 )

417 )

371 OnConflictDoRaise

418 OnConflictDoRaise

372 (Returning $ #messageStorageId `as` #fromOnly)

419 (Returning $ #messageStorageId `as` #fromOnly)

373

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+

374createGroupChatQ :: Manipulation Schema (TuplePG GroupChatCreation) (RowPG (Only GroupChatId))

432createGroupChatQ :: Manipulation Schema (TuplePG GroupChatCreation) (RowPG (Only GroupChatId))

375createGroupChatQ = insertRow #groupChats

433createGroupChatQ = insertRow #groupChats

376 (

434 (

@@ -446,7 +504,7 @@ getChatsQ lim dir = select (

446 (ifThenElse

504 (ifThenElse

447 (#messageStorageAuthorId .== param @1)

505 (#messageStorageAuthorId .== param @1)

448 #messageStorageDestinationUserId

506 #messageStorageDestinationUserId

449− (notNull #messageStorageAuthorId)) `as` #messageUserId) $

507+ #messageStorageAuthorId) `as` #messageUserId) $

450 from (table #messages) &

508 from (table #messages) &

451 where_ (isNotNull #messageStorageDestinationUserId .&&

509 where_ (isNotNull #messageStorageDestinationUserId .&&

452 (#messageStorageAuthorId .== param @1 .||

510 (#messageStorageAuthorId .== param @1 .||

@@ -513,21 +571,83 @@ getGroupChatForUserQ = selectStar $

513getFacultySearchResultQ :: Query Schema (TuplePG (Only Text)) (RowPG Faculty)

571getFacultySearchResultQ :: Query Schema (TuplePG (Only Text)) (RowPG Faculty)

514getFacultySearchResultQ = selectStar (from (table #faculties) &

572getFacultySearchResultQ = selectStar (from (table #faculties) &

515 where_ (vector @@ query) &

573 where_ (vector @@ query) &

574+ orderBy [

575+ tsRankCd vector1 query & Desc,

576+ tsRankCd vector2 query & Desc,

516− orderBy [tsRankCd vector query & Desc])

577+ tsRankCd vector query & Desc

578+ ])

517 where

579 where

518 vector = tsVector "russian" (textArrayToText [

580 vector = tsVector "russian" (textArrayToText [

519 #facultyName,

581 #facultyName,

520 #facultyPath,

582 #facultyPath,

521 #facultyCampusName,

583 #facultyCampusName,

522 (arrayToText #facultyTags)])

584 (arrayToText #facultyTags)])

585+ vector1 = tsVector "russian" #facultyName

586+ vector2 = tsVector "russian" (textArrayToText [

587+ #facultyName,

588+ #facultyPath])

523 query = tsQuery "russian" (param @1)

589 query = tsQuery "russian" (param @1)

524

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+

525tsRankCd

645tsRankCd

526 :: Expression schema from grouping params ('NotNull 'PGtext)

646 :: Expression schema from grouping params ('NotNull 'PGtext)

527 -> Expression schema from grouping params ('NotNull 'PGtext)

647 -> Expression schema from grouping params ('NotNull 'PGtext)

528 -> Expression schema from grouping params ('NotNull 'PGfloat4)

648 -> Expression schema from grouping params ('NotNull 'PGfloat4)

529tsRankCd vector query = UnsafeExpression $

649tsRankCd vector query = UnsafeExpression $

530− "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"])

531

651

532tsVector

652tsVector

533 :: ByteString -- ^ Language

653 :: ByteString -- ^ Language

@@ -536,6 +656,12 @@ tsVector

536tsVector lang x = UnsafeExpression $

656tsVector lang x = UnsafeExpression $

537 "to_tsvector" <> parenthesized (commaSeparated [singleQuotedUtf8 lang, renderExpression x])

657 "to_tsvector" <> parenthesized (commaSeparated [singleQuotedUtf8 lang, renderExpression x])

538

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+

539tsQuery

665tsQuery

540 :: ByteString -- ^ Language

666 :: ByteString -- ^ Language

541 -> Expression schema from grouping params ('NotNull 'PGtext)

667 -> Expression schema from grouping params ('NotNull 'PGtext)

@@ -543,6 +669,12 @@ tsQuery

543tsQuery lang x = UnsafeExpression $

669tsQuery lang x = UnsafeExpression $

544 "to_tsquery" <> parenthesized (commaSeparated [singleQuotedUtf8 lang, renderExpression x])

670 "to_tsquery" <> parenthesized (commaSeparated [singleQuotedUtf8 lang, renderExpression x])

545

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+

546arrayToText

678arrayToText

547 :: Expression schema from grouping params ('NotNull ('PGvararray ('NotNull 'PGtext)))

679 :: Expression schema from grouping params ('NotNull ('PGvararray ('NotNull 'PGtext)))

548 -> Expression schema from grouping params ('NotNull 'PGtext)

680 -> Expression schema from grouping params ('NotNull 'PGtext)

@@ -625,14 +757,47 @@ getTokenQ = selectStar (from (table #tokens) &

625 where_ (#tokenUserId .== param @1 .&&

757 where_ (#tokenUserId .== param @1 .&&

626 #tokenValue .== param @2))

758 #tokenValue .== param @2))

627

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+

628getVerifiedTokenQ :: Query Schema (TuplePG (UserId, ByteString)) (RowPG Token)

771getVerifiedTokenQ :: Query Schema (TuplePG (UserId, ByteString)) (RowPG Token)

629getVerifiedTokenQ = selectStar (from (table #tokens) &

772getVerifiedTokenQ = selectStar (from (table #tokens) &

630 where_ (#tokenUserId .== param @1 .&&

773 where_ (#tokenUserId .== param @1 .&&

631 #tokenValue .== param @2 .&&

774 #tokenValue .== param @2 .&&

632− 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))

633

790

634-- MARK: FrontEnd Data Structures

791-- MARK: FrontEnd Data Structures

635

792

793+instance HasValidatableText UserCreation where

794+ validateText UserCreation{..} = all validateText [

795+ userCreationFirstName,

796+ userCreationMiddleName,

797+ userCreationLastName,

798+ userCreationUserFaculty,

799+ userCreationUserEmail]

800+

636data UserCreation = UserCreation {

801data UserCreation = UserCreation {

637 userCreationFirstName :: Text,

802 userCreationFirstName :: Text,

638 userCreationMiddleName :: Text,

803 userCreationMiddleName :: Text,

@@ -651,9 +816,18 @@ instance ToJSON UserCreation where

651 ]

816 ]

652

817

653instance FromJSON UserCreation where

818instance FromJSON UserCreation where

654− parseJSON = withObject "named channel" $ \e ->

819+ parseJSON = withObject "user creation" $ \e ->

655 UserCreation <$> e .: "firstName" <*> e .: "middleName" <*> e .: "lastName" <*> e .: "faculty" <*> e .: "email"

820 UserCreation <$> e .: "firstName" <*> e .: "middleName" <*> e .: "lastName" <*> e .: "faculty" <*> e .: "email"

656

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+

657data NamedChannelCreation = NamedChannelCreation {

831data NamedChannelCreation = NamedChannelCreation {

658 namedChannelCreationOwner :: UserId,

832 namedChannelCreationOwner :: UserId,

659 namedChannelCreationName :: Text,

833 namedChannelCreationName :: Text,

@@ -689,11 +863,13 @@ getChannelForUser uId cId = do

689 Nothing -> lift $ S.throwError S.err404

863 Nothing -> lift $ S.throwError S.err404

690

864

691-- TODO: Reject bad requests. Should be binary.

865-- TODO: Reject bad requests. Should be binary.

692−verifiedUsers :: [UserId] -> StaticPQ [UserId]

866+verifyUsers :: [UserId] -> StaticPQ ()

693−verifiedUsers uIds =

867+verifyUsers uIds =

694 case verifiedUserIdsQ uIds of

868 case verifiedUserIdsQ uIds of

869+ Just uIdsQ -> do

695− 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

696− Nothing -> return []

872+ Nothing -> return ()

697

873

698deleteGroupChat :: GroupChatId -> StaticPQ ()

874deleteGroupChat :: GroupChatId -> StaticPQ ()

699deleteGroupChat gId = do

875deleteGroupChat gId = do

@@ -755,30 +931,40 @@ getAllUsers :: StaticPQ [User Faculty]

755getAllUsers = fmap rowToUser <$> (runQuery getAllUsersQ >>= getRows)

931getAllUsers = fmap rowToUser <$> (runQuery getAllUsersQ >>= getRows)

756

932

757publishPost :: UserId -> PostCreation -> StaticPQ PostId

933publishPost :: UserId -> PostCreation -> StaticPQ PostId

758−publishPost uId pc = commitedTransactionallyUpdate $ do

934+publishPost uId pc = commitedTransactionallyUpdate $ do

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

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

760 case pId' of

936 case pId' of

761 (Just (Only pId)) -> do

937 (Just (Only pId)) -> do

762− traversePrepared_ createPostElementRowsQ $ elementsToRows pId (postCreationBody pc)

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

763 return pId

939 return pId

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

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

765

941

766createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)

942createNewChannel :: UserId -> NamedChannelCreationRequest -> StaticPQ (Maybe NamedChannelId)

767createNewChannel uId req = commitedTransactionallyUpdate $ do

943createNewChannel uId req = commitedTransactionallyUpdate $ do

768− uIds <- verifiedUsers . toList $ namedChannelCreationRequestPeopleIds req

944+ let uIds = toList $ namedChannelCreationRequestPeopleIds req

945+ verifyUsers uIds

769 cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow

946 cId <- manipulateParams createNamedChannelQ (addUserToChannelCreate uId (req {namedChannelCreationRequestPeopleIds = fromList uIds})) >>= firstRow

770 return $ fmap fromOnly cId

947 return $ fmap fromOnly cId

771

948

949+channelCountForUser :: UserId -> StaticPQ Int64

950+channelCountForUser uId = (fromMaybe 0 . fmap fromOnly) <$> (runQueryParams countChannelsQ (Only uId) >>= firstRow)

951+

772updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()

952updateChannel :: UserId -> NamedChannel UserId -> StaticPQ ()

773−updateChannel uId req = commitedTransactionallyUpdate $ do

953+updateChannel uId req = do

774− uIds <- fmap fromList . verifiedUsers . toList $ namedChannelPeopleIds req

954+ let uIds = namedChannelPeopleIds req

955+ verifyUsers (toList uIds)

775 _ <- getChannelForUser uId $ namedChannelId req

956 _ <- getChannelForUser uId $ namedChannelId req

776− _ <- manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})

957+ _ <- commitedTransactionallyUpdate $ manipulateParams updateNamedChannelQ $ addUserToChannelUpdate uId (req {namedChannelPeopleIds = uIds})

777 return ()

958 return ()

778

959

779getFaculty :: Text -> StaticPQ Faculty

960getFaculty :: Text -> StaticPQ Faculty

780getFaculty t = runQueryParams getFacultyQ (Only t) >>= firstRow >>= fromMaybe404

961getFaculty t = runQueryParams getFacultyQ (Only t) >>= firstRow >>= fromMaybe404

781

962

963+isValidFaculty :: FacultyUrl -> StaticPQ Bool

964+isValidFaculty url = do

965+ (faculty :: Maybe Faculty) <- runQueryParams getFacultyQ (Only url) >>= firstRow

966+ return $ isJust faculty

967+

782updateFaculty :: Faculty -> StaticPQ ()

968updateFaculty :: Faculty -> StaticPQ ()

783updateFaculty fac = void $ manipulateParams updateFacultyQ fac

969updateFaculty fac = void $ manipulateParams updateFacultyQ fac

784

970

@@ -815,13 +1001,13 @@ getAllChannels uId = fmap (map removeUserFromChannel) $

815 runQueryParams getAllChannelsForUserQ (Only uId) >>= getRows

1001 runQueryParams getAllChannelsForUserQ (Only uId) >>= getRows

816

1002

817deleteNamedChannel :: UserId -> NamedChannelId -> StaticPQ ()

1003deleteNamedChannel :: UserId -> NamedChannelId -> StaticPQ ()

818−deleteNamedChannel uId cId = commitedTransactionallyUpdate $ do

1004+deleteNamedChannel uId cId = do

819 _ <- getChannelForUser uId cId

1005 _ <- getChannelForUser uId cId

820− _ <- manipulateParams deleteNamedChannelQ (Only cId)

1006+ _ <- commitedTransactionallyUpdate $ manipulateParams deleteNamedChannelQ (Only cId)

821 return ()

1007 return ()

822

1008

823−getTags :: StaticPQ [String]

1009+getTags :: Limit -> StaticPQ [String]

824−getTags = map fromOnly <$> (runQuery getTagsQ >>= getRows)

1010+getTags lim = map fromOnly <$> (runQuery (getNpopularTagsQ lim) >>= getRows)

825

1011

826getDialogs

1012getDialogs

827 :: UserId

1013 :: UserId

@@ -854,36 +1040,40 @@ getMessagesInGroupChat

854getMessagesInGroupChat selfId gId mId lim dir = do

1040getMessagesInGroupChat selfId gId mId lim dir = do

855 _ <- getGroupChatForUser selfId gId

1041 _ <- getGroupChatForUser selfId gId

856 resp <- runQueryParams (getGroupMessagesQ lim dir) (gId, mId) >>= getRows

1042 resp <- runQueryParams (getGroupMessagesQ lim dir) (gId, mId) >>= getRows

857− (return . sequence . map restoreMessage $ resp) >>= fromMaybe500

1043+ return . catMaybes . map restoreMessage $ resp

858

1044

859sendMessage :: UserId -> MessageCreation -> StaticPQ MessageId

1045sendMessage :: UserId -> MessageCreation -> StaticPQ MessageId

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

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

861 _ <- getGroupChatForUser selfId gId

1047 _ <- getGroupChatForUser selfId gId

862− (Only mId) <- manipulateParams createMessageQ (selfId, Just gId, uId, body)

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

863 >>= firstRow >>= fromMaybe500

1049 >>= firstRow >>= fromMaybe500

864 return mId

1050 return mId

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

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

1052+ verifyUsers [uId]

866− (Only mId) <- manipulateParams createMessageQ (selfId, gId, Just uId, body)

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

867 >>= firstRow >>= fromMaybe500

1054 >>= firstRow >>= fromMaybe500

868 return mId

1055 return mId

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

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

870

1057

871createGroupChat :: UserId -> GroupChatCreation -> StaticPQ GroupChatId

1058createGroupChat :: UserId -> GroupChatCreation -> StaticPQ GroupChatId

872createGroupChat uId (GroupChatCreation (Jsonb chatUsers) name) = do

1059createGroupChat uId (GroupChatCreation (Jsonb chatUsers) name) = do

1060+ verifyUsers . M.keys $ chatUsers

1061+ commitedTransactionallyUpdate $ do

873− let chatUsers' = M.insert uId maxChatPermissions chatUsers

1062+ let chatUsers' = M.insert uId maxChatPermissions chatUsers

874− (Only chatId) <- manipulateParams createGroupChatQ (GroupChatCreation (Jsonb chatUsers') name)

1063+ (Only chatId) <- manipulateParams createGroupChatQ (GroupChatCreation (Jsonb chatUsers') name)

875− >>= firstRow >>= fromMaybe500

1064+ >>= firstRow >>= fromMaybe500

876− -- TODO: Do somehting with this

1065+ _ <- manipulateParams createPhantomMessageQ (Only chatId)

877− _ <- sendMessage uId $ MessageCreation (Just chatId) Nothing (Jsonb $ Markdown "henlo")

878− return chatId

1066+ return chatId

879

1067

880updateGroupChat :: UserId -> GroupChat -> StaticPQ ()

1068updateGroupChat :: UserId -> GroupChat -> StaticPQ ()

881−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

882− (GroupChat _ (Jsonb perms') _) <- getGroupChatForUser uId gId

1072+ (GroupChat _ (Jsonb perms') _) <- getGroupChatForUser uId gId

883− let userPerm = fromMaybe minChatPermissions $ M.lookup uId perms'

1073+ let userPerm = fromMaybe minChatPermissions $ M.lookup uId perms'

884− unless (isAdmin userPerm) $ lift $ S.throwError $ S.err401

1074+ unless (isAdmin userPerm) $ lift $ S.throwError $ S.err401

885− let newPerms = M.insert uId userPerm perms

1075+ let newPerms = M.insert uId userPerm perms

886− void $ manipulateParams updateGroupChatQ (GroupChat gId (Jsonb newPerms) name)

1076+ void $ manipulateParams updateGroupChatQ (GroupChat gId (Jsonb newPerms) name)

887

1077

888leaveGroupChat :: UserId -> GroupChatId -> StaticPQ ()

1078leaveGroupChat :: UserId -> GroupChatId -> StaticPQ ()

889leaveGroupChat uId gId = commitedTransactionallyUpdate $ do

1079leaveGroupChat uId gId = commitedTransactionallyUpdate $ do

@@ -900,30 +1090,60 @@ getGroupChatForUser uId gId = do

900 (Just c) -> return c

1090 (Just c) -> return c

901 Nothing -> lift $ S.throwError S.err404

1091 Nothing -> lift $ S.throwError S.err404

902

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+

903getFacultyFromQuery :: T.Text -> StaticPQ [Faculty]

1098getFacultyFromQuery :: T.Text -> StaticPQ [Faculty]

904getFacultyFromQuery query =

1099getFacultyFromQuery query =

905− 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)

906

1114

907createToken :: Token -> StaticPQ ()

1115createToken :: Token -> StaticPQ ()

908createToken token = void $ manipulateParams createTokenQ token

1116createToken token = void $ manipulateParams createTokenQ token

909

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

910

1130

911-- NOTE: Not transactional

1131-- NOTE: Not transactional

912validateToken :: Token -> StaticPQ ()

1132validateToken :: Token -> StaticPQ ()

913validateToken token = do

1133validateToken token = do

914− void $ manipulateParams updateTokenQ token{tokenVerificationCode = Nothing}

1134+ void $ manipulateParams updateTokenQ token{tokenVerificationCode = Nothing, tokenActivationCode = Nothing}

915 void $ manipulateParams validateUserQ $ Only $ tokenUserId token

1135 void $ manipulateParams validateUserQ $ Only $ tokenUserId token

916

1136

917invalidateToken :: UserId -> ByteString -> StaticPQ ()

1137invalidateToken :: UserId -> ByteString -> StaticPQ ()

918invalidateToken uId bs = void . manipulateParams deleteTokenQ $ (uId, bs)

1138invalidateToken uId bs = void . manipulateParams deleteTokenQ $ (uId, bs)

919

1139

920−tryVerifyToken :: UserId -> ByteString -> Int32 -> StaticPQ (Maybe Token)

1140+tryVerifyToken :: UserId -> ByteString -> Int -> StaticPQ (Maybe Token)

921tryVerifyToken uId tokenData code = commitedTransactionallyUpdate $ do

1141tryVerifyToken uId tokenData code = commitedTransactionallyUpdate $ do

922− token' <- runQueryParams getTokenQ (uId, tokenData) >>= firstRow

1142+ token' <- runQueryParams getTokenQ (uId, hash tokenData) >>= firstRow

923 case token' of

1143 case token' of

924 Nothing -> return Nothing

1144 Nothing -> return Nothing

925 Just token -> do

1145 Just token -> do

926− if (tokenVerificationCode token == Just code)

1146+ if (tokenVerificationCode token == Just (hashVerificationCode code))

927 then validateToken token >> (return $ Just token)

1147 then validateToken token >> (return $ Just token)

928 else do

1148 else do

929 let triesLeft = tokenActivationTriesLeft token - 1

1149 let triesLeft = tokenActivationTriesLeft token - 1

@@ -934,11 +1154,37 @@ tryVerifyToken uId tokenData code = commitedTransactionallyUpdate $ do

934 _ <- manipulateParams updateTokenQ newToken

1154 _ <- manipulateParams updateTokenQ newToken

935 return Nothing

1155 return Nothing

936

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+

937getVerifiedToken :: UserId -> ByteString -> StaticPQ (Maybe Token)

1171getVerifiedToken :: UserId -> ByteString -> StaticPQ (Maybe Token)

938−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)

939

1176

940-- MARK: Utils

1177-- MARK: Utils

941

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+

942data UserRow = UserRow {

1188data UserRow = UserRow {

943 userRowId :: UserId,

1189 userRowId :: UserId,

944 userRowFirstName :: Text,

1190 userRowFirstName :: Text,

@@ -974,8 +1220,21 @@ rowToUser UserRow{..} = User {

974 userEmail = userRowEmail

1220 userEmail = userRowEmail

975 }

1221 }

976

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+

977queryFromText :: Text -> Text

1233queryFromText :: Text -> Text

978−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 <> ":*"

979

1238

980directionToOperator

1239directionToOperator

981 :: P.PaginationDirection

1240 :: P.PaginationDirection

denis/src/Data/Schema.hs+7−7

@@ -151,10 +151,10 @@ type Schema =

151 ] :=>

152 '[

153 "messageStorageId" ::: 'Def :=> 'NotNull 'PGint8,

154− "messageStorageAuthorId" ::: 'NoDef :=> 'NotNull 'PGint8,

154+ "messageStorageAuthorId" ::: 'NoDef :=> 'Null 'PGint8,

155 "messageStorageDestinationGroupId" ::: 'NoDef :=> 'Null 'PGint8,

156 "messageStorageDestinationUserId" ::: 'NoDef :=> 'Null 'PGint8,

157− "messageStorageBody" ::: 'NoDef :=> 'NotNull (PG (Jsonb (PostElement Message))),

157+ "messageStorageBody" ::: 'NoDef :=> 'Null (PG (Jsonb (PostElement Message))),

158 "messageStorageTime" ::: 'NoDef :=> 'NotNull 'PGtimestamptz

159 ]),

160 "tokens" ::: 'Table (

@@ -166,7 +166,7 @@ type Schema =

166 "tokenUserId" ::: 'NoDef :=> 'NotNull 'PGint8,

167 "tokenValue" ::: 'NoDef :=> 'NotNull 'PGbytea,

168 "tokenExpiryDate" ::: 'NoDef :=> 'NotNull 'PGtimestamptz,

169− "tokenVerificationCode" ::: 'NoDef :=> 'Null 'PGint4, -- null == verified

169+ "tokenVerificationCode" ::: 'NoDef :=> 'Null 'PGbytea, -- null == verified

170 "tokenActivationTriesLeft" ::: 'NoDef :=> 'NotNull 'PGint4,

171 "tokenUserAgent" ::: 'NoDef :=> 'NotNull 'PGtext,

172 "tokenActivationCode" ::: 'NoDef :=> 'Null 'PGbytea,

@@ -211,7 +211,7 @@ createTables = createTable #faculties (

211 ) (

212 primaryKey #userRowId `as` #pk_users :*

213 unique #userRowEmail `as` #user_email :*

214− foreignKey #userRowFacultyUrl #faculties #facultyUrl OnDeleteCascade OnUpdateCascade `as` #fk_user_faculty

214+ foreignKey #userRowFacultyUrl #faculties #facultyUrl OnDeleteRestrict OnUpdateCascade `as` #fk_user_faculty

215 ) >>> createTable #posts (

216 serial8 `as` #postRowId :*

217 notNullable int8 `as` #postRowAuthorId :*

@@ -279,10 +279,10 @@ createTables = createTable #faculties (

279 primaryKey #groupChatId `as` #pk_group_chats

280 ) >>> createTable #messages (

281 serial8 `as` #messageStorageId :*

282− notNullable int8 `as` #messageStorageAuthorId :*

282+ nullable int8 `as` #messageStorageAuthorId :*

283 nullable int8 `as` #messageStorageDestinationGroupId :*

284 nullable int8 `as` #messageStorageDestinationUserId :*

285− notNullable jsonb `as` #messageStorageBody :*

285+ nullable jsonb `as` #messageStorageBody :*

286 notNullable timestampWithTimeZone `as` #messageStorageTime

287 ) (

288 primaryKey #messageStorageId `as` #pk_messages :*

@@ -293,7 +293,7 @@ createTables = createTable #faculties (

293 notNullable int8 `as` #tokenUserId :*

294 notNullable bytea `as` #tokenValue :*

295 notNullable timestampWithTimeZone `as` #tokenExpiryDate :*

296− nullable int4 `as` #tokenVerificationCode :*

296+ nullable bytea `as` #tokenVerificationCode :*

297 notNullable int4 `as` #tokenActivationTriesLeft :*

298 notNullable text `as` #tokenUserAgent :*

299 nullable bytea `as` #tokenActivationCode :*

denis/src/Data/Tags/Completions.hs+10−9

@@ -18,25 +18,26 @@ import Data.Bifunctor

18import Data.Maybe

19import GHC.Generics

20import Servant.Docs

21+import Data.Char

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"]

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)

31−instance ToJSON (CompletionTree Char) where

32+instance ToJSON CompletionTree where

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

6+import Data.Text as T

7+import Data.Char as C

8+import qualified Data.Set as S

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 #-}

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 ,

7 TypeOperators,

8 OverloadedStrings,

9− DeriveAnyClass #-}

9+ DeriveAnyClass,

10+ RecordWildCards #-}

11module Data.User (

12module Data.User (

12 User(..),

13 User(..),

13 UserId,

14 UserId,

14− UserEmail

15+ UserEmail,

16+ UserUpdate(..)

15) where

17) where

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

25-- MARK: Documentation

30-- MARK: Documentation

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"]

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

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,

4 TypeOperators,

5 OverloadedStrings,

6− ScopedTypeVariables #-}

6+ ScopedTypeVariables,

7+ RecordWildCards #-}

7{-# OPTIONS_GHC -Wno-orphans #-}

8{-# OPTIONS_GHC -Wno-orphans #-}

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

35-- MARK: Documentation

41-- MARK: Documentation

@@ -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."]])

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."

42-- MARK: Implementation

53-- MARK: Implementation

@@ -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,

5 OverloadedStrings ,

6 TypeApplications ,

7− TypeOperators #-}

7+ TypeOperators,

8+ RecordWildCards #-}

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."

25-- MARK: Implementation

37-- MARK: Implementation

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]

34channelsApi :: UserId -> ServerT ChannelsApi App

47channelsApi :: UserId -> ServerT ChannelsApi App

38getChannelsApi :: UserId -> App [NamedChannel UserId]

51getChannelsApi :: UserId -> App [NamedChannel UserId]

39getChannelsApi uId = runQnotFound $ getAllChannels uId

52getChannelsApi uId = runQnotFound $ getAllChannels uId

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

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

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

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

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

19import Data.Connection

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

27type CompletionsDescription = Description "\

28 \Gets tag completion tree\n\n\

@@ -63,18 +63,21 @@ type CompletionsDescription = Description "\

63 \}\n\

64 \```"

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."

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]

71tagsServer :: ServerT TagsAPI App

72−tagsServer = completionHandler :<|> suggestionHandler

72+tagsServer = completionHandler :<|> tagSearch

74−completionHandler :: App (CompletionTree Char)

74+completionHandler :: App CompletionTree

75−completionHandler = runQerror $ mkCompletionTree <$> getTags

75+completionHandler = runQerror $ mkCompletionTree <$> getTags 1000

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

19import Data.Query

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

23type SearchDescription = Description "Returns faculties for given string"

28type SearchDescription = Description "Returns faculties for given string"

@@ -29,4 +34,9 @@ facultyServer :: ServerT FacultyAPI App

29facultyServer = search

34facultyServer = search

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,

5 OverloadedStrings ,

6 TypeApplications ,

7− TypeOperators #-}

7+ TypeOperators,

8+ RecordWildCards #-}

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

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 =

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

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

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

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

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

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

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

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

20import Data.Connection

21import Server.Query.Pagination

22+import Data.Limits

23+import Server.Error

24+import Control.Monad

25+import Data.Text.Validator

23-- MARK: Implementation

27-- MARK: Implementation

@@ -31,13 +35,21 @@ postApi :: UserId -> ServerT PostApi App

31postApi uId = getPostsApi :<|> lastPosts :<|> getPostsForUserApi :<|> publishPostApi uId

35postApi uId = getPostsApi :<|> lastPosts :<|> getPostsForUserApi :<|> publishPostApi uId

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

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

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

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,

16 asks,

17 liftIO,

18− MailConfig(..)

18+ MailConfig(..),

19+ fromMaybeThrow

19) where

20) where

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

29type App = ReaderT Config Handler

31type App = ReaderT Config Handler

@@ -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}

@@ -45,4 +47,11 @@ data MailConfig = MailConfig {

45}

47}

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+155−35

@@ -11,6 +11,7 @@

11 DeriveAnyClass,

12 RecordWildCards #-}

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

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

58-- MARK: Documentation

62-- MARK: Documentation

@@ -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]

66−instance ToSample Int32 where

70+instance ToSample Int where

67 toSamples _ = samples [382934, 103845, 294905]

71 toSamples _ = samples [382934, 103845, 294905]

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

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."

100

@@ -79,6 +106,10 @@ type RegisterDescription = Description "Register the user for a new account.\n\n

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."

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

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

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,20 +314,19 @@ 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

@@ -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)

24import Data.Text (Text)

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)

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

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

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(..),

14 generateToken,

15 TokenVerificationCode,

16− generateTokenM

16+ generateTokenM,

17+ hashVerificationCode,

18+ GeneratedToken(..),

19+ hash

17 ) where

20 ) where

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

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+}

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)

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

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 #-}

3module Server.Error (

4− invalidToken

4+ invalidToken,

5+ amountExceeded,

6+ lengthExceeded,

7+ formatError,

8+ impossibleContent,

9+ throwError

5) where

10) where

7import Servant.Server

12import Servant.Server

13+import Control.Monad.Except

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

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

26 (GroupDialog <$> map snd (toSamples Proxy) <*> map snd (toSamples Proxy)))

28−data Dialog = GroupDialog GroupChat Message | UserDialog UserId Message

28+data Dialog = GroupDialog GroupChat (Maybe Message) | UserDialog UserId Message

29 deriving Show

31instance ToJSON Dialog where

@@ -44,10 +44,10 @@ instance ToJSON Dialog where

45data ChatsResponse = ChatsResponse {

46 chatResponseMessageId :: MessageId,

47− chatResponseMessageAuthorId :: UserId,

47+ chatResponseMessageAuthorId :: Maybe UserId,

48 chatResponseMessageDestinationGroupId :: Maybe GroupChatId,

49 chatResponseMessageDestinationUserId :: Maybe UserId,

50− chatResponseMessageBody :: Jsonb (PostElement Message),

50+ chatResponseMessageBody :: Maybe (Jsonb (PostElement Message)),

51 chatResponseMessageTime :: UTCTime,

52 chatResponseGroupUsers :: Maybe (Jsonb UserPermissions),

53 chatResponseGroupName :: Maybe Text

@@ -60,13 +60,17 @@ responseToDialogs :: UserId -> [ChatsResponse] -> Maybe [Dialog]

60responseToDialogs selfId = sequence . map toDialog

61 where

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

65 (if selfId == uId then dId else uId)

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

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

denis/src/Server/Query/Pagination.hs+5−1

@@ -13,7 +13,8 @@

14module Server.Query.Pagination (

15 PaginatingRequest(..),

16− PaginationDirection(..)

16+ PaginationDirection(..),

17+ validatePaginationRequest

17 ) where

18 ) where

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)

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

denis/src/Server/Server.hs+28−11

@@ -1,7 +1,12 @@

1+{-# LANGUAGE

1−{-# LANGUAGE OverloadedStrings #-}

2+ OverloadedStrings,

3+ TypeOperators,

4+ DataKinds #-}

3module Server.Server (

6module Server.Server (

4− runServer

7+ runServer,

8+ hoistedServer,

9+ getConfig

5) where

10) where

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

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

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

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 #-}

8+module Orphans where

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 #-}

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 @@

3+--

4+-- Data for Name: groupChats; Type: TABLE DATA; Schema: public; Owner: qsfrneimsrtpjz

5+--

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:

41- taggy-0.2.1

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