{-# language OverloadedStrings, DeriveGeneric #-} module MCServer ( receivers ) where import Data.Aeson import qualified Data.ByteString.Lazy as B import qualified Data.Text as T import Data.Maybe ( fromJust ) import Discord ( DiscordHandler ) import Discord.Types ( Message ( messageChannel ) ) import GHC.Generics import Network.HTTP.Conduit ( simpleHttp ) import UnliftIO ( liftIO ) import Command import CSV ( writeSingleColCSV , readSingleColCSV ) import Utils ( developerRequirement ) import Owoifier ( owoify ) receivers :: [Message -> DiscordHandler ()] receivers :: [Message -> DiscordHandler ()] receivers = [ Command (ReaderT DiscordHandle IO) -> Message -> DiscordHandler () forall (m :: * -> *). MonadDiscord m => Command m -> Message -> m () runCommand Command (ReaderT DiscordHandle IO) forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m getStatus , Command (ReaderT DiscordHandle IO) -> Message -> DiscordHandler () forall (m :: * -> *). MonadDiscord m => Command m -> Message -> m () runCommand Command (ReaderT DiscordHandle IO) forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Command m setServer ] data ServerStatus = ServerStatus { ServerStatus -> String ip :: String, ServerStatus -> Bool online :: Bool, ServerStatus -> Maybe ServerMOTD motd :: Maybe ServerMOTD, ServerStatus -> Maybe ServerPlayers players :: Maybe ServerPlayers, ServerStatus -> Maybe String version :: Maybe String, ServerStatus -> Maybe String software :: Maybe String } deriving (Int -> ServerStatus -> ShowS [ServerStatus] -> ShowS ServerStatus -> String (Int -> ServerStatus -> ShowS) -> (ServerStatus -> String) -> ([ServerStatus] -> ShowS) -> Show ServerStatus forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ServerStatus] -> ShowS $cshowList :: [ServerStatus] -> ShowS show :: ServerStatus -> String $cshow :: ServerStatus -> String showsPrec :: Int -> ServerStatus -> ShowS $cshowsPrec :: Int -> ServerStatus -> ShowS Show, (forall x. ServerStatus -> Rep ServerStatus x) -> (forall x. Rep ServerStatus x -> ServerStatus) -> Generic ServerStatus forall x. Rep ServerStatus x -> ServerStatus forall x. ServerStatus -> Rep ServerStatus x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep ServerStatus x -> ServerStatus $cfrom :: forall x. ServerStatus -> Rep ServerStatus x Generic) instance FromJSON ServerStatus instance ToJSON ServerStatus data ServerMOTD = ServerMOTD { ServerMOTD -> [String] raw :: [String], ServerMOTD -> [String] clean :: [String], ServerMOTD -> [String] html :: [String] } deriving (Int -> ServerMOTD -> ShowS [ServerMOTD] -> ShowS ServerMOTD -> String (Int -> ServerMOTD -> ShowS) -> (ServerMOTD -> String) -> ([ServerMOTD] -> ShowS) -> Show ServerMOTD forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ServerMOTD] -> ShowS $cshowList :: [ServerMOTD] -> ShowS show :: ServerMOTD -> String $cshow :: ServerMOTD -> String showsPrec :: Int -> ServerMOTD -> ShowS $cshowsPrec :: Int -> ServerMOTD -> ShowS Show, (forall x. ServerMOTD -> Rep ServerMOTD x) -> (forall x. Rep ServerMOTD x -> ServerMOTD) -> Generic ServerMOTD forall x. Rep ServerMOTD x -> ServerMOTD forall x. ServerMOTD -> Rep ServerMOTD x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep ServerMOTD x -> ServerMOTD $cfrom :: forall x. ServerMOTD -> Rep ServerMOTD x Generic) instance FromJSON ServerMOTD instance ToJSON ServerMOTD data ServerPlayers = ServerPlayers { ServerPlayers -> Integer players_online :: Integer, ServerPlayers -> Integer players_max :: Integer } deriving (Int -> ServerPlayers -> ShowS [ServerPlayers] -> ShowS ServerPlayers -> String (Int -> ServerPlayers -> ShowS) -> (ServerPlayers -> String) -> ([ServerPlayers] -> ShowS) -> Show ServerPlayers forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [ServerPlayers] -> ShowS $cshowList :: [ServerPlayers] -> ShowS show :: ServerPlayers -> String $cshow :: ServerPlayers -> String showsPrec :: Int -> ServerPlayers -> ShowS $cshowsPrec :: Int -> ServerPlayers -> ShowS Show, (forall x. ServerPlayers -> Rep ServerPlayers x) -> (forall x. Rep ServerPlayers x -> ServerPlayers) -> Generic ServerPlayers forall x. Rep ServerPlayers x -> ServerPlayers forall x. ServerPlayers -> Rep ServerPlayers x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep ServerPlayers x -> ServerPlayers $cfrom :: forall x. ServerPlayers -> Rep ServerPlayers x Generic) instance FromJSON ServerPlayers where parseJSON :: Value -> Parser ServerPlayers parseJSON = Options -> Value -> Parser ServerPlayers forall a. (Generic a, GFromJSON Zero (Rep a)) => Options -> Value -> Parser a genericParseJSON (Options -> Value -> Parser ServerPlayers) -> Options -> Value -> Parser ServerPlayers forall a b. (a -> b) -> a -> b $ Options defaultOptions { fieldLabelModifier :: ShowS fieldLabelModifier = ShowS playersPrefix } instance ToJSON ServerPlayers playersPrefix :: String -> String playersPrefix :: ShowS playersPrefix String "players_online" = String "online" playersPrefix String "players_max" = String "max" jsonURL :: String jsonURL :: String jsonURL = String "https://api.mcsrvstat.us/2/" getJSON :: T.Text -> IO B.ByteString getJSON :: Text -> IO ByteString getJSON Text server_ip = String -> IO ByteString forall (m :: * -> *). MonadIO m => String -> m ByteString simpleHttp (String -> IO ByteString) -> String -> IO ByteString forall a b. (a -> b) -> a -> b $ String jsonURL String -> ShowS forall a. Semigroup a => a -> a -> a <> Text -> String T.unpack Text server_ip fetchServerDetails :: T.Text -> IO (Either String String) fetchServerDetails :: Text -> IO (Either String String) fetchServerDetails Text server_ip = do Either String ServerStatus serverDeetsM <- (ByteString -> Either String ServerStatus forall a. FromJSON a => ByteString -> Either String a eitherDecode (ByteString -> Either String ServerStatus) -> IO ByteString -> IO (Either String ServerStatus) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> IO ByteString getJSON Text server_ip) :: IO (Either String ServerStatus) Either String String -> IO (Either String String) forall (f :: * -> *) a. Applicative f => a -> f a pure (Either String String -> IO (Either String String)) -> Either String String -> IO (Either String String) forall a b. (a -> b) -> a -> b $ case Either String ServerStatus serverDeetsM of Left String err -> String -> Either String String forall a b. a -> Either a b Left String err Right ServerStatus serverDeets -> do let serverStatus :: String serverStatus = [String] -> String forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [ String ":pick: The Minecraft server is ", String "**", if ServerStatus -> Bool online ServerStatus serverDeets then String "online" else String "offline", String "**. " ] if Bool -> Bool not (ServerStatus -> Bool online ServerStatus serverDeets) then String -> Either String String forall a b. b -> Either a b Right String serverStatus else do let playersonline :: String playersonline = Integer -> String forall a. Show a => a -> String show (Integer -> String) -> Integer -> String forall a b. (a -> b) -> a -> b $ ServerPlayers -> Integer players_online (ServerPlayers -> Integer) -> ServerPlayers -> Integer forall a b. (a -> b) -> a -> b $ Maybe ServerPlayers -> ServerPlayers forall a. HasCallStack => Maybe a -> a fromJust (Maybe ServerPlayers -> ServerPlayers) -> Maybe ServerPlayers -> ServerPlayers forall a b. (a -> b) -> a -> b $ ServerStatus -> Maybe ServerPlayers players ServerStatus serverDeets let playersmax :: String playersmax = Integer -> String forall a. Show a => a -> String show (Integer -> String) -> Integer -> String forall a b. (a -> b) -> a -> b $ ServerPlayers -> Integer players_max (ServerPlayers -> Integer) -> ServerPlayers -> Integer forall a b. (a -> b) -> a -> b $ Maybe ServerPlayers -> ServerPlayers forall a. HasCallStack => Maybe a -> a fromJust (Maybe ServerPlayers -> ServerPlayers) -> Maybe ServerPlayers -> ServerPlayers forall a b. (a -> b) -> a -> b $ ServerStatus -> Maybe ServerPlayers players ServerStatus serverDeets let motdclean :: String motdclean = [String] -> String alwaysHead ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b $ ServerMOTD -> [String] clean (ServerMOTD -> [String]) -> ServerMOTD -> [String] forall a b. (a -> b) -> a -> b $ Maybe ServerMOTD -> ServerMOTD forall a. HasCallStack => Maybe a -> a fromJust (Maybe ServerMOTD -> ServerMOTD) -> Maybe ServerMOTD -> ServerMOTD forall a b. (a -> b) -> a -> b $ ServerStatus -> Maybe ServerMOTD motd ServerStatus serverDeets let ipstr :: String ipstr = ServerStatus -> String ip ServerStatus serverDeets let ver :: String ver = Maybe String -> String forall a. HasCallStack => Maybe a -> a fromJust (Maybe String -> String) -> Maybe String -> String forall a b. (a -> b) -> a -> b $ ServerStatus -> Maybe String version ServerStatus serverDeets let onlineServerDeets :: String onlineServerDeets = [String] -> String forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat [ String "Current Players: ", String playersonline, String "/", String playersmax, String ".\n", String "Message of the Day: *", String motdclean, String "*\n", String "Come join at `", String ipstr, String "` on version `", String ver, String "`" ] String -> Either String String forall a b. b -> Either a b Right (String -> Either String String) -> String -> Either String String forall a b. (a -> b) -> a -> b $ String serverStatus String -> ShowS forall a. Semigroup a => a -> a -> a <> String onlineServerDeets alwaysHead :: [String] -> String alwaysHead :: [String] -> String alwaysHead [] = String "" alwaysHead (String a:[String] as) = String a getStatus :: (MonadDiscord m, MonadIO m) => Command m getStatus :: Command m getStatus = Text -> (Message -> m ()) -> Command m forall (m :: * -> *) h. (CommandHandlerType m h, MonadDiscord m) => Text -> h -> Command m command Text "minecraft" ((Message -> m ()) -> Command m) -> (Message -> m ()) -> Command m forall a b. (a -> b) -> a -> b $ \Message m -> do Text server_ip <- IO Text -> m Text forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO IO Text readServerIP Either String String deets <- IO (Either String String) -> m (Either String String) forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO (Either String String) -> m (Either String String)) -> IO (Either String String) -> m (Either String String) forall a b. (a -> b) -> a -> b $ Text -> IO (Either String String) fetchServerDetails Text server_ip case Either String String deets of Left String err -> IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (String -> IO () forall a. Show a => a -> IO () print String err) m () -> m () -> m () forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Message -> Text -> m () forall (m :: * -> *). MonadDiscord m => Message -> Text -> m () respond Message m (String -> Text T.pack String err) Right String nice -> Message -> Text -> m () forall (m :: * -> *). MonadDiscord m => Message -> Text -> m () respond Message m (Text -> m ()) -> Text -> m () forall a b. (a -> b) -> a -> b $ Text -> Text owoify (Text -> Text) -> Text -> Text forall a b. (a -> b) -> a -> b $ String -> Text T.pack String nice readServerIP :: IO T.Text readServerIP :: IO Text readServerIP = do [Text] server_ip <- String -> IO [Text] readSingleColCSV String "mcServer.csv" if [Text] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [Text] server_ip then String -> [Text] -> IO () writeSingleColCSV String "mcServer.csv" [Text "123.456.789.123"] IO () -> IO Text -> IO Text forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> Text -> IO Text forall (f :: * -> *) a. Applicative f => a -> f a pure Text "123.456.789.123" else Text -> IO Text forall (f :: * -> *) a. Applicative f => a -> f a pure (Text -> IO Text) -> Text -> IO Text forall a b. (a -> b) -> a -> b $ [Text] -> Text forall a. [a] -> a head [Text] server_ip setServer :: (MonadDiscord m, MonadIO m) => Command m setServer :: Command m setServer = (Message -> m (Maybe Text)) -> Command m -> Command m forall (m :: * -> *). (Message -> m (Maybe Text)) -> Command m -> Command m requires Message -> m (Maybe Text) forall (m :: * -> *). (MonadDiscord m, MonadIO m) => Message -> m (Maybe Text) developerRequirement (Command m -> Command m) -> Command m -> Command m forall a b. (a -> b) -> a -> b $ Text -> (Message -> Text -> m ()) -> Command m forall (m :: * -> *) h. (CommandHandlerType m h, MonadDiscord m) => Text -> h -> Command m command Text "setMinecraft" ((Message -> Text -> m ()) -> Command m) -> (Message -> Text -> m ()) -> Command m forall a b. (a -> b) -> a -> b $ \Message m Text server_ip -> do IO () -> m () forall (m :: * -> *) a. MonadIO m => IO a -> m a liftIO (IO () -> m ()) -> IO () -> m () forall a b. (a -> b) -> a -> b $ String -> [Text] -> IO () writeSingleColCSV String "mcServer.csv" [Text server_ip] Message -> Text -> m () forall (m :: * -> *). MonadDiscord m => Message -> Text -> m () respond Message m Text "Success!"