Report planes

Author: easafe

src/Client/Experiments/Update.purs

@@ -19,7 +19,7 @@ import Effect.Class as EC
 import Flame (Update)
 import Flame as F
 import Flame.Subscription as FS
-import Shared.Im.Types (RetryableRequest(..))
+import Shared.Im.Types (ReportReason(..), RetryableRequest(..))
 import Shared.Im.Types as SIT
 import Shared.Modal (Modal(..), ScreenModal(..))
 import Shared.ResizeInput as SIR
@@ -56,6 +56,14 @@ update model =
             AfterCatchPlane id → afterCatchPlane id model
             PassPaperPlane id → passPaperPlane id model
             AfterPassPlane id → afterPassPlane id model
+            ReportPlane id userId → reportPlane id userId model
+
+reportPlane ∷ Int → Int → ExperimentsModel → ExperimentsModel /\ (Array (Aff (Maybe ExperimentsMessage)))
+reportPlane id userId model = model { paperPlane = model.paperPlane { loading = true } } /\ [ setIt ]
+      where
+      setIt = do
+            void <<< CCN.silentResponse $ request.im.report { body: { userId, reason: OtherReason, comment: Just $ "paper plane reported: " <> show id } }
+            pure <<< Just $ PassPaperPlane id
 
 afterPassPlane ∷ Int → ExperimentsModel → ExperimentsModel /\ (Array (Aff (Maybe ExperimentsMessage)))
 afterPassPlane id model =
@@ -119,7 +127,7 @@ afterThrowPlane id model =
             { paperPlane = model.paperPlane
                     { loading = false
                     , message = Nothing
-                    , thrown = { id, message: SU.fromJust model.paperPlane.message, status: Flying } : model.paperPlane.thrown
+                    , thrown = { id, thrower: model.user.id, message: SU.fromJust model.paperPlane.message, status: Flying } : model.paperPlane.thrown
                     }
             } /\ []
 

src/Client/css/experiments.css

@@ -102,11 +102,16 @@
 }
 
 .paper-catch {
-    color: var(--merochat-green);
+    color:var(--light-color);
     margin-left: 10px;
     margin-bottom: 15px;
 }
 
+.paper-catch.report {
+    margin-right: auto;
+    margin-left: 0;
+}
+
 .paper-catch:last-child {
     font-weight: bold;
 }

src/Server/Experiments/Database.purs

@@ -36,9 +36,7 @@ fetchExperiments = SD.query $ select (_id /\ _code /\ _name /\ _description) # f
 fetchExperimentUser ∷ Int → ServerEffect ChatExperimentUser
 fetchExperimentUser loggedUserId = do
       record ← SD.single $ select (array_agg _feature # as _privileges) # from (join privileges karma_leaderboard # on (_ranker .=. loggedUserId .&&. _quantity .<=. _current_karma))
-      pure <<< { privileges: _ } $ SU.fromJust do
-            r ← record
-            r.privileges
+      pure { id: loggedUserId, privileges: SU.fromJust (record >>= _.privileges) }
 
 fetchAnswerCount ∷ Int → ServerEffect Int
 fetchAnswerCount loggedUserId = do
@@ -71,20 +69,20 @@ countPaperPlanes loggedUserId = do
       count ← SD.single $ select (count _id # as c) # from paper_planes # wher (_thrower .=. loggedUserId .&&. _status .<>. Crashed)
       pure $ map _.c count
 
-updatePlaneStatus ∷ Int → Int -> PaperPlaneStatus -> ServerEffect Unit
-updatePlaneStatus loggedUserId id status = SD.execute $ update paper_planes # set (_status .=. status) # wher (_id .=. id .&&. _by .=.  loggedUserId)
+updatePlaneStatus ∷ Int → Int → PaperPlaneStatus → ServerEffect Unit
+updatePlaneStatus loggedUserId id status = SD.execute $ update paper_planes # set (_status .=. status) # wher (_id .=. id .&&. _by .=. loggedUserId)
 
-updatePlaneBy ∷ Int → Int -> ServerEffect Unit
-updatePlaneBy loggedUserId id  = SD.execute $ update paper_planes # set (_by .=. Nothing) # wher (_id .=. id .&&. _by .=.  loggedUserId)
+updatePlaneBy ∷ Int → Int → ServerEffect Unit
+updatePlaneBy loggedUserId id = SD.execute $ update paper_planes # set (_by .=. Nothing) # wher (_id .=. id .&&. _by .=. loggedUserId)
 
 fetchPaperPlanes ∷ Int → ServerEffect (Array PaperPlane)
-fetchPaperPlanes loggedUserId = SD.query $ select (_id /\ _message /\ _status) # from paper_planes # wher (_thrower .=. loggedUserId .&&. _status .<>. Crashed) # orderBy _created
+fetchPaperPlanes loggedUserId = SD.query $ select (_id /\ _message /\ _thrower /\ _status) # from paper_planes # wher (_thrower .=. loggedUserId .&&. _status .<>. Crashed) # orderBy _created
 
 fetchPaperPlanesFlying ∷ Int → ServerEffect (Array PaperPlane)
-fetchPaperPlanesFlying loggedUserId = SD.query $ select (_id /\ _message /\ _status) # from paper_planes # wher (_by .=. loggedUserId .&&. _status .=. Flying) # orderBy _byAt
+fetchPaperPlanesFlying loggedUserId = SD.query $ select (_id /\ _message /\ _thrower /\ _status) # from paper_planes # wher (_by .=. loggedUserId .&&. _status .=. Flying) # orderBy _byAt
 
 fetchPaperPlanesCaught ∷ Int → ServerEffect (Array PaperPlane)
-fetchPaperPlanesCaught loggedUserId = SD.query $ select (_id /\ _message /\ _status) # from paper_planes # wher (_by .=. loggedUserId .&&. _status .=. Caught) # orderBy _byAt
+fetchPaperPlanesCaught loggedUserId = SD.query $ select (_id /\ _message /\ _thrower /\ _status) # from paper_planes # wher (_by .=. loggedUserId .&&. _status .=. Caught) # orderBy _byAt
 
 q ∷ Proxy "q"
 q = Proxy

src/Shared/Experiments/PaperPlane.purs

@@ -21,7 +21,7 @@ view model = HE.div [ HA.class' "paper-plane duller" ]
       , case model.paperPlane.section of
               ShowNew → new model
               ShowFlyingBy → flyingBy model
-              ShowCaught -> caught model
+              ShowCaught → caught model
       ]
 
 caught ∷ ExperimentsModel → Html ExperimentsMessage
@@ -51,7 +51,8 @@ flyingBy model =
                     [ HE.div [ HA.class' "paper-flown-message" ] [ HE.text plane.message ]
                     ]
             , HE.div [ HA.class' "paper-thrown-options" ]
-                    [ HE.a [ HA.class' "paper-catch", HA.onClick $ PassPaperPlane plane.id ] [ HE.text "Pass" ]
+                    [ HE.a [ HA.class' "paper-catch report", HA.onClick $ ReportPlane plane.id plane.thrower ] [ HE.text "Report" ]
+                    , HE.a [ HA.class' "paper-catch", HA.onClick $ PassPaperPlane plane.id ] [ HE.text "Pass" ]
                     , HE.a [ HA.class' "paper-catch", HA.onClick $ CatchPaperPlane plane.id ] [ HE.text "Catch!" ]
                     ]
             ]

src/Shared/Experiments/Types.purs

@@ -25,7 +25,7 @@ type ChatExperiment =
       , code ∷ Experiment
       }
 
-type ChatExperimentUser = { privileges ∷ Array Privilege }
+type ChatExperimentUser = { id :: Int, privileges ∷ Array Privilege }
 
 data ExperimentsMessage
       = ToggleVisibility ScreenModal
@@ -52,6 +52,7 @@ data ExperimentsMessage
       | AfterCatchPlane Int
       | PassPaperPlane Int
       | AfterPassPlane Int
+      | ReportPlane Int Int
 
 type Match =
       { name ∷ String
@@ -61,6 +62,7 @@ type Match =
 type PaperPlane =
       { id ∷ Int
       , message ∷ String
+      , thrower :: Int
       , status ∷ PaperPlaneStatus
       }