Replacing discord by reddit

api/src/Api/About.hs

@@ -44,8 +44,8 @@ $(deriveJSON defaultOptions ''ServerAbout)
 $(deriveJSON defaultOptions ''About)
 
 servicesDir :: [(FilePath, S.ByteString)]
-servicesDir = $(embedDir "./services/")
--- servicesDir = undefined
+-- servicesDir = $(embedDir "./services/")
+servicesDir = undefined
 
 about :: SockAddr -> AppM About
 about host = do

api/src/Api/OIDC.hs

@@ -7,7 +7,7 @@ module Api.OIDC where
 
 import App (AppM)
 import Control.Monad.IO.Class (liftIO)
-import Core.User (ExternalToken (ExternalToken, service), Service (Github, Spotify, Twitter, Google, Anilist, Discord), UserId (UserId), User (User))
+import Core.User (ExternalToken (ExternalToken, service), Service (Github, Spotify, Twitter, Google, Anilist, Reddit), UserId (UserId), User (User))
 import Data.Text (pack)
 import Core.OIDC ( getOauthTokens )
 import Repository.User (updateTokens, getTokensByUserId, delTokens)
@@ -43,11 +43,11 @@ urlHandler Anilist (Just r) = do
     backRedirect <- liftIO $ envAsString "BACK_URL" ""
     throwError $ err302 { errHeaders =
         [("Location", B8.pack $ "https://anilist.co/api/v2/oauth/authorize?client_id=" ++ clientId ++ "&response_type=code&redirect_uri=" ++ backRedirect ++ "auth/redirect" ++ "&state=" ++ r)] } 
-urlHandler Discord (Just r) = do
-    clientId <- liftIO $ envAsString "DISCORD_CLIENT_ID" ""
+urlHandler Reddit (Just r) = do
+    clientId <- liftIO $ envAsString "REDDIT_CLIENT_ID" ""
     backRedirect <- liftIO $ envAsString "BACK_URL" ""
     throwError $ err302 { errHeaders =
-        [("Location", B8.pack $ "https://discord.com/api/oauth2/authorize?response_type=code&scope=identify%20guilds%20messages.read%20activities.write%20webhook.incoming&client_id=" ++ clientId ++ "&response_type=code&redirect_uri=" ++ backRedirect ++ "auth/redirect" ++ "&state=" ++ r)] } 
+        [("Location", B8.pack $ "https://www.reddit.com/api/v1/authorize?client_id=" ++ clientId ++ "&response_type=code&state=" ++ r ++ "&redirect_uri=" ++ backRedirect ++ "auth/redirect" ++ "&duration=permanent&scope=*")] } 
 urlHandler Google  (Just r) = do
     clientId <- liftIO $ envAsString "GOOGLE_CLIENT_ID" ""
     backRedirect <- liftIO $ envAsString "BACK_URL" ""
@@ -63,7 +63,6 @@ urlHandler Spotify (Just r) = do
     backRedirect <- liftIO $ envAsString "BACK_URL" ""
     throwError $ err302 { errHeaders =
         [("Location", B8.pack $ "https://accounts.spotify.com/authorize?response_type=code&scope=user-library-read user-library-modify streaming playlist-modify-private playlist-read-collaborative playlist-read-private playlist-modify-public user-modify-playback-state user-read-private&client_id=" ++ clientId ++ "&redirect_uri=" ++ backRedirect ++ "auth/redirect" ++ "&state=" ++ r)] }
-
 urlHandler Github  (Just r) = do
     clientId <- liftIO $ envAsString "GITHUB_CLIENT_ID" ""
     backRedirect <- liftIO $ envAsString "BACK_URL" ""

api/src/Core/OIDC.hs

@@ -6,7 +6,7 @@ import qualified Data.ByteString.Char8 as B8
 import qualified Data.HashMap.Strict as HM
 
 import App (AppM)
-import Core.User (ExternalToken (ExternalToken, expiresAt), Service (Github, Discord, Spotify, Google, Twitter, Anilist))
+import Core.User (ExternalToken (ExternalToken, expiresAt), Service (Github, Reddit, Spotify, Google, Twitter, Anilist))
 import Data.Aeson.Types (Object, Value (String))
 import Data.Text (Text, pack, unpack)
 import Network.HTTP.Simple (JSONException, addRequestHeader, getResponseBody, httpJSONEither, parseRequest, setRequestMethod, setRequestQueryString, setRequestBodyURLEncoded)
@@ -63,17 +63,17 @@ getGithubTokens code = do
             access <- lookupObjString obj "access_token"
             Just $ ExternalToken (pack access) "" currTime Github
 
--- DISCORD
-getDiscordConfig :: IO OAuth2Conf
-getDiscordConfig =
+-- Reddit
+getRedditConfig :: IO OAuth2Conf
+getRedditConfig =
     OAuth2Conf
-        <$> envAsString "DISCORD_CLIENT_ID" ""
-        <*> envAsString "DISCORD_SECRET" ""
-        <*> pure "https://discord.com/api/oauth2/token"
+        <$> envAsString "REDDIT_CLIENT_ID" ""
+        <*> envAsString "REDDIT_SECRET" ""
+        <*> pure "https://www.reddit.com/api/v1/access_token"
 
-getDiscordTokens :: String -> IO (Maybe ExternalToken)
-getDiscordTokens code = do
-    cfg <- getDiscordConfig
+getRedditTokens :: String -> IO (Maybe ExternalToken)
+getRedditTokens code = do
+    cfg <- getRedditConfig
     let endpoint = tokenEndpoint code cfg
     request' <- parseRequest endpoint
     let request =
@@ -96,7 +96,7 @@ getDiscordTokens code = do
             refresh <- lookupObjString obj "refresh_token"
             expiresIn <- lookupObjInt obj "expires_in"
             let expiresAt = addUTCTime (fromInteger . fromIntegral $ expiresIn) currTime
-            Just $ ExternalToken (pack access) (pack refresh) expiresAt Discord
+            Just $ ExternalToken (pack access) (pack refresh) expiresAt Reddit
 
 -- GOOGLE
 getGoogleConfig :: IO OAuth2Conf
@@ -246,7 +246,7 @@ getAnilistTokens code = do
 -- General
 getOauthTokens :: Service -> String -> IO (Maybe ExternalToken)
 getOauthTokens Github = getGithubTokens
-getOauthTokens Discord = getDiscordTokens
+getOauthTokens Reddit = getRedditTokens
 getOauthTokens Spotify = getSpotifyTokens
 getOauthTokens Google = getGoogleTokens
 getOauthTokens Twitter = getTwitterTokens

api/src/Core/User.hs

@@ -26,7 +26,7 @@ newtype UserId = UserId {toInt64 :: Int64}
     deriving newtype (DBEq, DBType, Eq, Show, Num, FromJSON, ToJSON, FromHttpApiData)
     deriving stock (Generic)
 
-data Service = Github | Google | Spotify | Twitter | Discord | Anilist
+data Service = Github | Google | Spotify | Twitter | Reddit | Anilist
     deriving (Eq, Show, Generic, ToJSON, FromJSON)
 
 instance FromHttpApiData Service where
@@ -35,7 +35,7 @@ instance FromHttpApiData Service where
     parseUrlPiece "google" = Right Google
     parseUrlPiece "spotify" = Right Spotify
     parseUrlPiece "twitter" = Right Twitter
-    parseUrlPiece "discord" = Right Discord
+    parseUrlPiece "reddit" = Right Reddit
     parseUrlPiece "anilist" = Right Anilist
     parseUrlPiece _ = Left "not a service"