You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

184 lines
7.7 KiB

3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
2 years ago
3 years ago
3 years ago
3 years ago
2 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
2 years ago
3 years ago
3 years ago
2 years ago
3 years ago
2 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
3 years ago
  1. {-# LANGUAGE OverloadedStrings #-}
  2. {-# LANGUAGE RecordWildCards #-}
  3. {-# LANGUAGE ScopedTypeVariables #-}
  4. module Main where
  5. import Commands ( edtCommand
  6. , edtResponse
  7. , groupCommand
  8. , groupResponse
  9. , helpCommand
  10. , helpResponse
  11. , pingCommand
  12. , pingResponse
  13. , remindCommand
  14. , remindResponse
  15. )
  16. import Commands.EDT ( getEdt )
  17. import Commands.Reminds ( Remind(..)
  18. , scheduleRemind
  19. , setupRemindDb
  20. )
  21. import Conf ( Config(..)
  22. , Group(..)
  23. , readConfig
  24. )
  25. import qualified Control.Concurrent
  26. import qualified Control.Event as E
  27. import Control.Monad ( void
  28. , when
  29. )
  30. import Control.Monad.IO.Unlift ( liftIO
  31. , toIO
  32. , withRunInIO
  33. )
  34. import qualified Data.Map.Strict as Map
  35. import qualified Data.Text as T
  36. import qualified Data.Text.IO as TIO
  37. import Data.Time ( getCurrentTime )
  38. import qualified Database.HDBC as DB
  39. import qualified Database.HDBC.Sqlite3 as DB.SQ3
  40. import Discord ( DiscordHandler
  41. , RunDiscordOpts(..)
  42. , def
  43. , restCall
  44. , runDiscord
  45. , sendCommand
  46. )
  47. import Discord.Interactions ( Interaction(..)
  48. , ApplicationCommandData(..)
  49. , interactionResponseBasic
  50. )
  51. import qualified Discord.Requests as R
  52. import Discord.Types ( Activity(..)
  53. , ActivityType(..)
  54. , Event(..)
  55. , GatewaySendable(..)
  56. , PartialApplication(..)
  57. , Snowflake(Snowflake)
  58. , UpdateStatusOpts(..)
  59. , UpdateStatusType(..)
  60. )
  61. import qualified System.Cron.Schedule as Cron
  62. import UnliftIO.Directory ( doesFileExist
  63. , removeFile
  64. )
  65. import System.Environment (setEnv)
  66. main :: IO ()
  67. main = do
  68. tok <- TIO.readFile "./auth.secret"
  69. conf <- readConfig "./conf.yaml"
  70. eventSystem <- E.initEventSystem
  71. setEnv "TZ" "Europe/Paris" -- The bot needs to run on the french timezone for edt to work properly
  72. err <- Discord.runDiscord $ Discord.def
  73. { discordToken = tok
  74. , discordOnStart = onDiscordStart conf eventSystem
  75. , discordOnEnd = liftIO $ putStrLn "Ended"
  76. , discordOnEvent = onDiscordEvent conf eventSystem
  77. , discordOnLog = \s -> TIO.putStrLn s >> TIO.putStrLn ""
  78. }
  79. TIO.putStrLn err
  80. onDiscordStart :: Config -> E.EventSystem -> Discord.DiscordHandler ()
  81. onDiscordStart conf@Config {..} eventSystem = do
  82. let activity :: Activity
  83. activity = Discord.def { activityName = "Doing stuff"
  84. , activityType = ActivityTypeGame
  85. , activityUrl = Nothing
  86. }
  87. opts :: UpdateStatusOpts
  88. opts = UpdateStatusOpts { updateStatusOptsSince = Nothing
  89. , updateStatusOptsGame = Just activity
  90. , updateStatusOptsNewStatus = UpdateStatusOnline
  91. , updateStatusOptsAFK = False
  92. }
  93. Discord.sendCommand (UpdateStatus opts)
  94. let glist = Map.toList configGroups
  95. withRunInIO $ \runInIO -> Cron.execSchedule $ do
  96. Cron.addJob (runInIO $ pushgroupedt conf "tomorrow" glist)
  97. configAutoEDTCronDay
  98. Cron.addJob (runInIO $ pushgroupedt conf "week" glist) configAutoEDTCronWeek
  99. -- Ensure the database is setup
  100. liftIO setupRemindDb
  101. -- Get the reminders out of the database
  102. conn <- liftIO $ DB.SQ3.connectSqlite3 "db.sqlite3"
  103. query <- liftIO $ DB.prepare
  104. conn
  105. "SELECT user, channel, message, dt \
  106. \FROM reminds \
  107. \WHERE (datetime(dt) > datetime('now'));"
  108. liftIO $ DB.execute query []
  109. reminds <- liftIO $ DB.fetchAllRows' query
  110. mapM_
  111. (\[u, c, m, d] -> do
  112. liftIO $ print [u, c, m, d]
  113. scheduleRemind
  114. eventSystem
  115. Remind { rmdUser = fromInteger $ DB.fromSql u
  116. , rmdChannel = fromInteger $ DB.fromSql c
  117. , rmdMessage = DB.fromSql m
  118. , rmdDatetime = DB.fromSql d
  119. }
  120. )
  121. reminds
  122. liftIO $ putStrLn "Started"
  123. onDiscordEvent :: Config -> E.EventSystem -> Event -> Discord.DiscordHandler ()
  124. onDiscordEvent conf@Config {..} eventSystem (Ready _ _ _ _ _ _ (PartialApplication i _))
  125. = do
  126. liftIO $ putStrLn "onready"
  127. mapM_
  128. (maybe
  129. (return ())
  130. (void . Discord.restCall . R.CreateGuildApplicationCommand i configServer)
  131. )
  132. [ pingCommand
  133. -- , edtCommand conf
  134. , remindCommand
  135. -- , groupCommand conf
  136. , helpCommand
  137. ]
  138. onDiscordEvent conf@Config {..} eventSystem (InteractionCreate InteractionApplicationCommand { applicationCommandData = ApplicationCommandDataChatInput { applicationCommandDataName = name, optionsData = opts, ..}, interactionChannelId = Just channel, interactionGuildId = Just guild, interactionUser = user, ..})
  139. = do
  140. response <- responseIO
  141. void $ Discord.restCall
  142. (R.CreateInteractionResponse interactionId interactionToken response)
  143. where
  144. responseIO = case name of
  145. "ping" -> liftIO $ pingResponse conf
  146. "edt" -> liftIO $ edtResponse conf opts
  147. "remind" -> remindResponse opts eventSystem channel user
  148. "group" -> groupResponse conf user guild opts
  149. "help" -> liftIO helpResponse
  150. _ ->
  151. return $ interactionResponseBasic $ "Unhandled Command: " `T.append` name
  152. onDiscordEvent _ _ _ = return ()
  153. pushgroupedt :: Config -> T.Text -> [(T.Text, Group)] -> Discord.DiscordHandler ()
  154. pushgroupedt conf@Config {..} day glist = do
  155. mapM_
  156. (\(gn, Group { groupChannel = gc }) -> do
  157. edt <- liftIO $ getEdt conf $ Map.fromList [("group", gn), ("day", day)]
  158. liftIO
  159. $ TIO.putStrLn
  160. $ "Putting out time table for group "
  161. <> gn
  162. <> " in "
  163. <> T.pack (show gc)
  164. <> ":\n"
  165. <> edt
  166. Discord.restCall $ R.CreateMessage gc edt
  167. return ()
  168. )
  169. glist