Merge pull request #805 from jappeace/really-upstream

Replace hardcoded channel with configured channel in link filters

Author: rexim

src/Bot.hs

@@ -402,11 +402,7 @@ builtinCommands =
       , mkBuiltinCommand
           ( "Suggest video for the friday stream"
           , $githubLinkLocationStr
-          , nonEmptyRoles
-              [qms|You have to be trusted to use this command.
-                   Subscribe to gain the trust instantly:
-                   https://twitch.tv/tsoding/subscribe|]
-              fridayCommand))
+          , nonEmptyRoles fridayCommand))
     , ( "videoq"
       , mkBuiltinCommand
           ( "Get the link to the current Friday Queue"
@@ -484,6 +480,11 @@ builtinCommands =
               [ ( "help"
                 , subcommand
                     [("setgist", setHelpGistId), ("refresh", refreshHelpGistId)])
+              , ( "reply"
+                , subcommand
+                    [ ("link", setNoTrustLinkReplyCommand)
+                    , ("command", setNoTrustCommandReplyCommand)
+                    ])
               ]))
     , ( "version"
       , mkBuiltinCommand
@@ -507,11 +508,7 @@ builtinCommands =
       , mkBuiltinCommand
           ( "Asciify Twitch, BTTV or FFZ emote"
           , $githubLinkLocationStr
-          , nonEmptyRoles
-              [qms|You have to be trusted to use this command.
-                   Subscribe to gain the trust instantly:
-                   https://twitch.tv/tsoding/subscribe|]
-              asciifyReaction))
+          , nonEmptyRoles asciifyReaction))
     ]
 
 nextStreamCommand :: Reaction Message a
@@ -708,9 +705,11 @@ dispatchCommand message = do
   dispatchCustomCommand message
 
 dispatchBuiltinCommand :: Message (Command T.Text) -> Effect ()
-dispatchBuiltinCommand message@Message {messageContent = Command { commandName = name
-                                                                 , commandArgs = args
-                                                                 }} =
+dispatchBuiltinCommand message@Message { messageSender = _
+                                       , messageContent = Command { commandName = name
+                                                                  , commandArgs = args
+                                                                  }
+                                       } =
   maybe
     (return ())
     (\bc -> runReaction (bcReaction bc) $ fmap (const args) message)

src/Bot/Links.hs

@@ -135,15 +135,10 @@ linkFilter reaction =
   Reaction
     (\case
        Message { messageContent = message
-               , messageSender = sender@Sender { senderRoles = []
-                                               , senderChannel = TwitchChannel _
-                                               }
+               , messageSender = sender@Sender {senderRoles = []}
                }
          | textContainsLink message -> do
            timeoutSender 1 sender
-           replyToSender
-             sender
-             [qms|Links are not allowed for untrusted users.
-                  Subscribe to gain the trust instantly:
-                  https://twitch.tv/tsoding/subscribe|]
+           reply <- entityPayload <$> noTrustReply
+           replyToSender sender $ noTrustLinkReply reply
        msg -> runReaction reaction msg)

src/Bot/Replies.hs

@@ -5,11 +5,16 @@ module Bot.Replies where
 
 import Data.Aeson
 import qualified Data.ByteString.Lazy as BS
+import Data.Functor
 import qualified Data.Map as M
+import Data.Maybe
+import Data.Proxy
 import qualified Data.Text as T
 import Effect
+import Entity
 import HyperNerd.Comonad
 import Network.HTTP.Simple (getResponseBody, parseRequest)
+import Property
 import Reaction
 import Regexp
 import Text.InterpolatedString.QM
@@ -79,14 +84,73 @@ onlyForRoles reply roles reaction =
 onlyForMods :: Reaction Message a -> Reaction Message a
 onlyForMods = onlyForRoles "Only for mods" authorityRoles
 
-nonEmptyRoles :: T.Text -> Reaction Message a -> Reaction Message a
-nonEmptyRoles reply reaction =
+nonEmptyRoles :: Reaction Message a -> Reaction Message a
+nonEmptyRoles reaction =
   transR duplicate $
   ifR
     (null . senderRoles . messageSender)
-    (cmapR (const reply) $ Reaction replyMessage)
+    (Reaction noTrust)
     (cmapR extract reaction)
 
+data NoTrustReply = NoTrustReply
+  { noTrustCommandReply :: T.Text
+  , noTrustLinkReply :: T.Text
+  } deriving (Eq)
+
+updateNoTrustCommandReply :: T.Text -> NoTrustReply -> NoTrustReply
+updateNoTrustCommandReply value reply = reply {noTrustCommandReply = value}
+
+updateNoTrustLinkReply :: T.Text -> NoTrustReply -> NoTrustReply
+updateNoTrustLinkReply value reply = reply {noTrustLinkReply = value}
+
+instance IsEntity NoTrustReply where
+  nameOfEntity Proxy = "NoTrustReply"
+  toProperties reply =
+    M.fromList
+      [ ("command", PropertyText $ noTrustCommandReply reply)
+      , ("link", PropertyText $ noTrustLinkReply reply)
+      ]
+  fromProperties properties =
+    NoTrustReply <$> extractProperty "command" properties <*>
+    extractProperty "link" properties
+
+setNoTrustLinkReplyCommand :: Reaction Message T.Text
+setNoTrustLinkReplyCommand =
+  liftR
+    (\msg -> do
+       reply <- noTrustReply
+       void $ updateEntityById $ fmap (updateNoTrustLinkReply msg) reply) $
+  cmapR (const "Updated not trust link reply message") $ Reaction replyMessage
+
+setNoTrustCommandReplyCommand :: Reaction Message T.Text
+setNoTrustCommandReplyCommand =
+  liftR
+    (\msg -> do
+       reply <- noTrustReply
+       void $ updateEntityById $ fmap (updateNoTrustCommandReply msg) reply) $
+  cmapR (const "Updated not trust command reply message") $
+  Reaction replyMessage
+
+noTrustReply :: Effect (Entity NoTrustReply)
+noTrustReply = do
+  reply <- listToMaybe <$> selectEntities Proxy (Take 1 All)
+  case reply of
+    Just reply' -> return reply'
+    Nothing ->
+      createEntity Proxy $
+      NoTrustReply
+        [qms|You have to be trusted to use this command.
+             Mods can change this message with
+             !config reply command <message>|]
+        [qms|You have to be trusted to send links.
+             Mods can change this message with
+             !config reply link <message>|]
+
+noTrust :: Message a -> Effect ()
+noTrust Message {messageSender = sender} = do
+  reply <- entityPayload <$> noTrustReply
+  replyToSender sender $ noTrustCommandReply reply
+
 onlyForTwitch :: Reaction Message a -> Reaction Message a
 onlyForTwitch reaction =
   Reaction $ \msg ->

src/Sqlite/EntityPersistence.hs

@@ -292,6 +292,16 @@ selectEntityIds conn name (Take n (Filter (PropertyEquals propertyName property)
     , ":propertyUTCTime" := (fromProperty property :: Maybe UTCTime)
     , ":n" := n
     ]
+selectEntityIds conn name (Take n All) =
+  map fromOnly <$>
+  queryNamed
+    conn
+    [r| SELECT entityId
+        FROM EntityProperty
+        WHERE entityName = :entityName
+        GROUP BY entityId
+        LIMIT :n |]
+    [":entityName" := name, ":n" := n]
 selectEntityIds conn name (Shuffle All) =
   map fromOnly <$>
   queryNamed

src/Transport.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module Transport where