Skip to content

Commit 0d24b20

Browse files
easafeeasafe
committed
Add asks form
1 parent 28161f8 commit 0d24b20

File tree

22 files changed

+264
-33
lines changed

22 files changed

+264
-33
lines changed

‎src/Client/Im/Asks.purs‎

Lines changed: 30 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -4,11 +4,12 @@ import Prelude
44

55
import Client.AppId (imAppId)
66
import Client.File as CCF
7-
import Client.Network (request)
8-
import Client.Network as CCN
97
import Client.Im.Flame (MoreMessages, NoMessages, NextMessage)
108
import Client.Im.WebSocket as CIW
9+
import Client.Network (request)
10+
import Client.Network as CCN
1111
import Control.Alt ((<|>))
12+
import Data.Array ((:))
1213
import Data.Array as DA
1314
import Data.Int as DI
1415
import Data.Maybe (Maybe(..))
@@ -34,3 +35,30 @@ import Web.Socket.WebSocket (WebSocket)
3435

3536
fetchAsks ∷ Int → ImModel → MoreMessages
3637
fetchAsks userId model = model /\ []
38+
39+
setAsk ∷ Maybe String → ImModel → MoreMessages
40+
setAsk value model = model { asks = model.asks { question = value } } /\ []
41+
42+
sendAsk ∷ Int → ImModel → MoreMessages
43+
sendAsk userId model = model { asks = model.asks { freeToSend = false } } /\ [ send ]
44+
where
45+
send = do
46+
response ← CCN.silentResponse $ request.asks.post { body: { userId, question: SU.fromJust model.asks.question } }
47+
pure <<< Just $ AfterSendAsk userId response.allowed
48+
49+
afterSendAsk ∷ Int → Boolean → ImModel → MoreMessages
50+
afterSendAsk userId allowed model =
51+
model
52+
{ asks = model.asks
53+
{ freeToSend = true
54+
, question = Nothing
55+
, sent = updatedSent
56+
, unallowed = updatedUnallowed
57+
}
58+
} /\ []
59+
where
60+
updatedSent /\ updatedUnallowed =
61+
if allowed then
62+
(userId : model.asks.sent) /\ model.asks.unallowed
63+
else
64+
model.asks.sent /\ (userId : model.asks.unallowed)

‎src/Client/Im/Main.purs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -73,6 +73,7 @@ import Shared.Routes (routes)
7373
import Shared.Settings.Types (PrivacySettings)
7474
import Shared.Unsafe as SU
7575
import Shared.User as SUR
76+
import Test.Client.Model (model)
7677
import Type.Proxy (Proxy(..))
7778
import Web.DOM.Element as WDE
7879
import Web.DOM.Node as WDN
@@ -190,6 +191,9 @@ update st model =
190191

191192
--asks
192193
SpecialRequest (FetchAsks userId) → CIA.fetchAsks userId model
194+
SetAsk value → CIA.setAsk value model
195+
SendAsk userId → CIA.sendAsk userId model
196+
AfterSendAsk userId allowed → CIA.afterSendAsk userId allowed model
193197

194198
--suggestion
195199
FetchMoreSuggestions → CIS.fetchMoreSuggestions model

‎src/Client/Im/Posts.purs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -130,6 +130,7 @@ toggleShowingSuggestions userId toggle model =
130130
--we need this bookkeeping for big suggestion cards
131131
, suggesting = Just userId
132132
, modal = Special $ ShowSuggestionCard userId
133+
, asks = model.asks { question = Nothing }
133134
, posts = model.posts { freeToFetch = not shouldFetch }
134135
} /\ effects
135136
where
@@ -149,6 +150,7 @@ toggleShowingContacts userId toggle model =
149150
model
150151
{ contacts = map update model.contacts
151152
, posts = model.posts { freeToFetch = not shouldFetch }
153+
, asks = model.asks { question = Nothing }
152154
, fullContactProfileVisible = true
153155
} /\ effects
154156
where

‎src/Client/css/im.css‎

Lines changed: 29 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2782,6 +2782,24 @@ label {
27822782
font-size: 0.95em;
27832783
}
27842784

2785+
.asks {
2786+
display: flex;
2787+
flex-direction: column;
2788+
}
2789+
2790+
.ask-button {
2791+
border: 0 !important;
2792+
margin-top: 10px;
2793+
}
2794+
2795+
.asks-form {
2796+
display: flex;
2797+
flex-direction: column;
2798+
width: 500px;
2799+
align-self: center;
2800+
padding: 15px 0;
2801+
}
2802+
27852803
.post-entry {
27862804
margin: 15px 0;
27872805
border-bottom: 1px dotted var(--light-color);
@@ -2843,12 +2861,17 @@ label {
28432861
padding-bottom: 15px;
28442862
}
28452863

2864+
.asks-form .chat-input,
28462865
.post-card .chat-input {
2847-
border: 0;
28482866
width: 93%;
28492867
border-radius: 5px;
28502868
}
28512869

2870+
.big-card .asks-form .chat-input,
2871+
.post-card .chat-input {
2872+
border: 0;
2873+
}
2874+
28522875
.post-card .svg-55 {
28532876
position: absolute;
28542877
right: 20px;
@@ -3616,6 +3639,11 @@ label {
36163639
padding: 20px;
36173640
}
36183641

3642+
.asks-form {
3643+
width: calc(100vw - 40px);
3644+
padding: 0px;
3645+
}
3646+
36193647
.modal-form .audio-button {
36203648
width: 56px;
36213649
height: 56px;

‎src/Server/Asks/Action.purs‎

Lines changed: 37 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,37 @@
1+
module Server.Asks.Action where
2+
3+
import Prelude
4+
5+
import Data.Array as DA
6+
import Data.Either (Either(..))
7+
import Data.Maybe as DM
8+
import Data.Nullable as DN
9+
import Data.String (Pattern(..))
10+
import Data.String as DS
11+
import Run.Except as RE
12+
import Server.Asks.Database as SAD
13+
import Server.Database.Privileges as SDP
14+
import Server.Database.Privileges as SPD
15+
import Server.Effect (ServerEffect)
16+
import Server.File as SF
17+
import Server.Sanitize as SS
18+
import Shared.Content (Content(..))
19+
import Shared.Markdown (Token(..))
20+
import Shared.Markdown as SM
21+
import Shared.Options.Ask (maxAskCharacters)
22+
import Shared.Options.Post (maxPostCharacters)
23+
import Shared.Post (Post, PostPayload)
24+
import Shared.Privilege (Privilege(..))
25+
import Shared.Resource (Media(..), ResourceType(..))
26+
import Shared.Resource as SP
27+
import Shared.ResponseError (ResponseError(..))
28+
29+
sendAsk ∷ Int → Int -> String → ServerEffect Boolean
30+
sendAsk loggedUserId userId question = do
31+
let trimmed = DS.trim question
32+
when (DS.length trimmed > maxAskCharacters) <<< RE.throw $ BadRequest { reason : "question too long" }
33+
canSendAsk <- SPD.hasPrivilege loggedUserId SendAsks
34+
unless canSendAsk <<< RE.throw $ BadRequest { reason : "not enough karma" }
35+
allowedToAsk ← SAD.isAllowedToAsk loggedUserId userId
36+
when allowedToAsk $ SAD.saveAsk loggedUserId userId question
37+
pure allowedToAsk

‎src/Server/Asks/Database.purs‎

Lines changed: 35 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,35 @@
1+
module Server.Asks.Database where
2+
3+
import Droplet.Language
4+
import Prelude hiding (not)
5+
6+
import Data.Maybe as DM
7+
import Data.Tuple.Nested ((/\))
8+
import Server.Database as SD
9+
import Server.Database.Asks (_answer, _answerer, _asker, asks)
10+
import Server.Database.Blocks (_blocked, _blocker, blocks)
11+
import Server.Database.DoppelgangerQuestions (_question)
12+
import Server.Database.Fields (_id, _recipient, _sender, l, s, u)
13+
import Server.Database.Histories (histories)
14+
import Server.Database.Types (Checked(..))
15+
import Server.Database.Users (_asksVisibility, _temporary, users)
16+
import Server.Effect (ServerEffect)
17+
import Shared.User (ProfileVisibility(..))
18+
19+
isAllowedToAsk :: Int -> Int -> ServerEffect Boolean
20+
isAllowedToAsk loggedUserId userId = do
21+
found <- SD.single $ select _id # from (users # as u) # wher ( u ... _id .=. userId .&&.
22+
( _asksVisibility .=. Everyone
23+
.||. _asksVisibility
24+
.=. NoTemporaryUsers
25+
.&&. not (exists $ select (1 # as l) # from (users # as s) # wher (s ... _id .=. loggedUserId .&&. _temporary .=. Checked true))
26+
.||. _asksVisibility
27+
.=. Contacts
28+
.&&. (exists $ select (1 # as l) # from (histories # as s) # wher (_sender .=. loggedUserId .&&. _recipient .=. userId .||. _recipient .=. loggedUserId .&&. _sender .=. userId))
29+
) .&&. not (exists $ select (1 # as u) # from blocks # wher (_blocker .=. loggedUserId .&&. _blocked .=. u ... _id .||. _blocker .=. u ... _id .&&. _blocked .=. loggedUserId))
30+
.&&. not (exists $ select (1 # as u) # from asks # wher (_answerer .=. (u ... _id) .&&. _asker .=. loggedUserId .&&. isNull _answer))
31+
)
32+
pure $ DM.isJust found
33+
34+
saveAsk :: Int -> Int -> String -> ServerEffect Unit
35+
saveAsk loggedUserId useId question = SD.execute $ insert # into asks (_asker /\ _answerer /\ _question) # values (loggedUserId /\ useId /\ question)

‎src/Server/Asks/Handler.purs‎

Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
module Server.Asks.Handler where
2+
3+
import Prelude
4+
import Server.Effect
5+
import Shared.Im.Types
6+
7+
import Data.Maybe (Maybe)
8+
import Data.Tuple (Tuple(..))
9+
import Payload.ContentType (html)
10+
import Payload.Headers as PH
11+
import Payload.ResponseTypes (Empty(..), Response)
12+
import Payload.Server.Response as PSR
13+
import Server.Asks.Action as SAA
14+
import Server.Im.Action as SIA
15+
import Server.Im.Template as SIT
16+
import Server.Posts.Action as SPA
17+
import Server.Response as SR
18+
import Shared.Account (EmailPassword)
19+
import Shared.Changelog (Changelog)
20+
import Shared.DateTime (DateTimeWrapper(..))
21+
import Shared.Html (Html(..))
22+
23+
24+
post ∷ { guards ∷ { loggedUserId ∷ Int }, body ∷ { userId :: Int, question :: String } } → ServerEffect { allowed:: Boolean }
25+
post request = do
26+
allowed <- SAA.sendAsk request.guards.loggedUserId request.body.userId request.body.question
27+
pure { allowed }
28+
29+

‎src/Server/Database/Asks.purs‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,9 @@ asks = Table
3131
_answerer ∷ Proxy "answerer"
3232
_answerer = Proxy
3333

34+
_asker ∷ Proxy "asker"
35+
_asker = Proxy
36+
3437
_answer ∷ Proxy "answer"
3538
_answer = Proxy
3639

‎src/Server/Handler.purs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,7 @@ import Run as R
1717
import Run.Except as RE
1818
import Run.Reader as RR
1919
import Server.Admin.Handler as SHA
20+
import Server.Asks.Handler as SAH
2021
import Server.Backer.Handler as SBH
2122
import Server.Banned.Handler as SBNH
2223
import Server.Elsewhere.Handler as SESH
@@ -54,6 +55,9 @@ handlers reading =
5455
, post: runJson reading SPSH.post
5556
, seen: runJson reading SPSH.seen
5657
}
58+
, asks:
59+
{ post: runJson reading SAH.post
60+
}
5761
, im:
5862
{ get: runHtml reading SIH.im
5963
, contacts: runJson reading SIH.contacts

‎src/Server/Im/Database/Flat.purs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -41,6 +41,7 @@ type FlatFields rest =
4141
, completedTutorial ∷ Checked
4242
, languages ∷ Maybe (Array String)
4343
, profileVisibility ∷ ProfileVisibility
44+
, asks_visibility ∷ ProfileVisibility
4445
, joined ∷ DateTime
4546
, readReceipts ∷ Checked
4647
, messageTimestamps ∷ Checked
@@ -98,6 +99,7 @@ fromFlatUser fc =
9899
, totalPosts: DM.fromMaybe 0 (fc.totalPosts >>= BI.toInt)
99100
, totalAsks: DM.fromMaybe 0 (fc.totalAsks >>= BI.toInt)
100101
, bin: fc.bin
102+
, asksVisibility: fc.asks_visibility
101103
, backer: SC.coerce fc.backer
102104
, profileVisibility: fc.profileVisibility
103105
, readReceipts: SC.coerce fc.readReceipts

0 commit comments

Comments
 (0)