feat: WIP preparing other OIDC

api/aeris.cabal

@@ -40,7 +40,11 @@ library
       Db.User
       Lib
       OIDC
+      OIDC.Discord
       OIDC.Github
+      OIDC.Google
+      OIDC.Spotify
+      OIDC.Twitter
       Password
       Repository
       Repository.Pipeline

api/src/Api/About.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DuplicateRecordFields #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+{-# HLINT ignore "Use newtype instead of data" #-}
 
 module Api.About where
 

api/src/OIDC/Discord.hs

@@ -0,0 +1,68 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module OIDC.Discord where
+import qualified Data.Text as T
+import qualified Data.HashMap.Strict as HM
+import qualified Data.ByteString.Char8 as B8
+
+import System.Environment.MrEnv ( envAsBool, envAsInt, envAsInteger, envAsString )
+import Network.HTTP.Simple (JSONException, parseRequest, setRequestMethod, addRequestHeader, setRequestQueryString, httpJSONEither, getResponseBody)
+import Data.Aeson.Types (Object, Value (String))
+import Data.Text ( Text, pack )
+import App (AppM)
+import Core.User (ExternalToken (ExternalToken), Service (Github))
+import Utils (lookupObj)
+
+data DiscordOAuth2 = DiscordOAuth2
+                    { oauthClientId :: String
+                    , oauthClientSecret :: String
+                    , oauthOAuthorizeEndpoint :: String
+                    , oauthAccessTokenEndpoint :: String
+                    , oauthCallback :: String
+                    } deriving (Show, Eq)
+
+
+getDiscordConfig :: IO DiscordOAuth2
+getDiscordConfig = DiscordOAuth2
+            <$> envAsString "DISCORD_CLIENT_ID" ""
+            <*> envAsString "DISCORD_SECRET" ""
+            <*> pure "https://github.com/login/oauth/authorize"
+            <*> pure "https://github.com/login/oauth/access_token"
+            <*> pure "http://localhost:8080/auth/github/token"
+
+
+githubAuthEndpoint :: DiscordOAuth2 -> String
+githubAuthEndpoint oa = concat  [ oauthOAuthorizeEndpoint oa
+                                , "?client_id=", oauthClientId oa
+                                , "&response_type=", "code"
+                                , "&redirect_uri=", oauthCallback oa]
+
+
+tokenEndpoint :: String -> DiscordOAuth2 -> String
+tokenEndpoint code oa = concat  [ oauthAccessTokenEndpoint oa
+                                , "?client_id=", oauthClientId oa
+                                , "&client_secret=", oauthClientSecret oa
+                                , "&code=", code]
+
+getGithubAuthEndpoint :: IO String
+getGithubAuthEndpoint = githubAuthEndpoint <$> getDiscordConfig
+
+-- Step 3. Exchange code for auth token
+getGithubTokens :: String -> IO (Maybe ExternalToken)
+getGithubTokens code = do
+  gh <- getDiscordConfig
+  let endpoint = tokenEndpoint code gh
+  request' <- parseRequest endpoint
+  let request = setRequestMethod "POST"
+                $ addRequestHeader "Accept" "application/json"
+                $ setRequestQueryString [ ("client_id", Just . B8.pack . oauthClientId $ gh)
+                                        , ("client_secret", Just . B8.pack . oauthClientSecret $ gh)
+                                        , ("code", Just . B8.pack $ code)]
+                $ request'
+  response <- httpJSONEither request
+  return $ case (getResponseBody response :: Either JSONException Object) of
+             Left _ -> Nothing
+             Right obj -> do
+               access <- lookupObj obj "access_token"
+               refresh <- lookupObj obj "refresh_token"
+               Just $ ExternalToken (pack access) (pack refresh) 0 Github

api/src/OIDC/Github.hs

@@ -1,20 +1,19 @@
 {-# LANGUAGE OverloadedStrings #-}
 
 module OIDC.Github where
-import qualified Data.Text as T
 import qualified Data.HashMap.Strict as HM
 import qualified Data.ByteString.Char8 as B8
 
 import System.Environment.MrEnv ( envAsBool, envAsInt, envAsInteger, envAsString )
 import Network.HTTP.Simple (JSONException, parseRequest, setRequestMethod, addRequestHeader, setRequestQueryString, httpJSONEither, getResponseBody)
 import Data.Aeson.Types (Object, Value (String))
-import Data.Text (Text)
+import Data.Text ( Text, pack )
 import App (AppM)
 import Core.User (ExternalToken (ExternalToken), Service (Github))
-import Data.Text (pack)
+import Utils (lookupObj)
 
 
-data GithubOAuth2 = GithubOAuth2 
+data GithubOAuth2 = GithubOAuth2
                     { oauthClientId :: String
                     , oauthClientSecret :: String
                     , oauthOAuthorizeEndpoint :: String
@@ -45,12 +44,6 @@ tokenEndpoint code oa = concat  [ oauthAccessTokenEndpoint oa
                                 , "&client_secret=", oauthClientSecret oa
                                 , "&code=", code]
 
-
-lookupObj :: Object -> Text -> Maybe String
-lookupObj obj key = case HM.lookup key obj of
-                            Just (String x) -> Just . T.unpack $ x
-                            _ -> Nothing
-
 getGithubAuthEndpoint :: IO String
 getGithubAuthEndpoint = githubAuthEndpoint <$> getGithubConfig
 
@@ -69,7 +62,7 @@ getGithubTokens code = do
   response <- httpJSONEither request
   return $ case (getResponseBody response :: Either JSONException Object) of
              Left _ -> Nothing
-             Right obj -> do 
+             Right obj -> do
                access <- lookupObj obj "access_token"
                refresh <- lookupObj obj "refresh_token"
                Just $ ExternalToken (pack access) (pack refresh) 0 Github

api/src/OIDC/Google.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module OIDC.Github where
+import qualified Data.Text as T
+import qualified Data.HashMap.Strict as HM
+import qualified Data.ByteString.Char8 as B8
+
+import System.Environment.MrEnv ( envAsBool, envAsInt, envAsInteger, envAsString )
+import Network.HTTP.Simple (JSONException, parseRequest, setRequestMethod, addRequestHeader, setRequestQueryString, httpJSONEither, getResponseBody)
+import Data.Aeson.Types (Object, Value (String))
+import Data.Text ( Text, pack )
+import App (AppM)
+import Core.User (ExternalToken (ExternalToken), Service (Github))
+import Utils (lookupObj)
+
+
+data GoogleOAuth2 = GoogleOAuth2
+                    { oauthClientId :: String
+                    , oauthClientSecret :: String
+                    , oauthAccessTokenEndpoint :: String
+                    } deriving (Show, Eq)
+
+
+getGoogleConfig :: IO GoogleOAuth2
+getGoogleConfig = GoogleOAuth2
+            <$> envAsString "GOOGLE_CLIENT_ID" ""
+            <*> envAsString "GOOGLE_SECRET" ""
+            <*> pure "https://github.com/login/oauth/access_token"
+
+tokenEndpoint :: String -> GoogleOAuth2 -> String
+tokenEndpoint code oa = concat  [ oauthAccessTokenEndpoint oa
+                                , "?client_id=", oauthClientId oa
+                                , "&client_secret=", oauthClientSecret oa
+                                , "&code=", code]
+
+-- Step 3. Exchange code for auth token
+getGithubTokens :: String -> IO (Maybe ExternalToken)
+getGithubTokens code = do
+  gh <- getGoogleConfig
+  let endpoint = tokenEndpoint code gh
+  request' <- parseRequest endpoint
+  let request = setRequestMethod "POST"
+                $ addRequestHeader "Accept" "application/json"
+                $ setRequestQueryString [ ("client_id", Just . B8.pack . oauthClientId $ gh)
+                                        , ("client_secret", Just . B8.pack . oauthClientSecret $ gh)
+                                        , ("code", Just . B8.pack $ code)]
+                $ request'
+  response <- httpJSONEither request
+  return $ case (getResponseBody response :: Either JSONException Object) of
+             Left _ -> Nothing
+             Right obj -> do
+               access <- lookupObj obj "access_token"
+               refresh <- lookupObj obj "refresh_token"
+               Just $ ExternalToken (pack access) (pack refresh) 0 Github

api/src/OIDC/Spotify.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module OIDC.Github where
+import qualified Data.Text as T
+import qualified Data.HashMap.Strict as HM
+import qualified Data.ByteString.Char8 as B8
+
+import System.Environment.MrEnv ( envAsBool, envAsInt, envAsInteger, envAsString )
+import Network.HTTP.Simple (JSONException, parseRequest, setRequestMethod, addRequestHeader, setRequestQueryString, httpJSONEither, getResponseBody)
+import Data.Aeson.Types (Object, Value (String))
+import Data.Text ( Text, pack )
+import App (AppM)
+import Core.User (ExternalToken (ExternalToken), Service (Github))
+
+
+data GithubOAuth2 = GithubOAuth2
+                    { oauthClientId :: String
+                    , oauthClientSecret :: String
+                    , oauthOAuthorizeEndpoint :: String
+                    , oauthAccessTokenEndpoint :: String
+                    , oauthCallback :: String
+                    } deriving (Show, Eq)
+
+
+getGithubConfig :: IO GithubOAuth2
+getGithubConfig = GithubOAuth2
+            <$> envAsString "GITHUB_CLIENT_ID" ""
+            <*> envAsString "GITHUB_SECRET" ""
+            <*> pure "https://github.com/login/oauth/authorize"
+            <*> pure "https://github.com/login/oauth/access_token"
+            <*> pure "http://localhost:8080/auth/github/token"
+
+
+githubAuthEndpoint :: GithubOAuth2 -> String
+githubAuthEndpoint oa = concat  [ oauthOAuthorizeEndpoint oa
+                                , "?client_id=", oauthClientId oa
+                                , "&response_type=", "code"
+                                , "&redirect_uri=", oauthCallback oa]
+
+
+tokenEndpoint :: String -> GithubOAuth2 -> String
+tokenEndpoint code oa = concat  [ oauthAccessTokenEndpoint oa
+                                , "?client_id=", oauthClientId oa
+                                , "&client_secret=", oauthClientSecret oa
+                                , "&code=", code]
+
+
+lookupObj :: Object -> Text -> Maybe String
+lookupObj obj key = case HM.lookup key obj of
+                            Just (String x) -> Just . T.unpack $ x
+                            _ -> Nothing
+
+getGithubAuthEndpoint :: IO String
+getGithubAuthEndpoint = githubAuthEndpoint <$> getGithubConfig
+
+-- Step 3. Exchange code for auth token
+getGithubTokens :: String -> IO (Maybe ExternalToken)
+getGithubTokens code = do
+  gh <- getGithubConfig
+  let endpoint = tokenEndpoint code gh
+  request' <- parseRequest endpoint
+  let request = setRequestMethod "POST"
+                $ addRequestHeader "Accept" "application/json"
+                $ setRequestQueryString [ ("client_id", Just . B8.pack . oauthClientId $ gh)
+                                        , ("client_secret", Just . B8.pack . oauthClientSecret $ gh)
+                                        , ("code", Just . B8.pack $ code)]
+                $ request'
+  response <- httpJSONEither request
+  return $ case (getResponseBody response :: Either JSONException Object) of
+             Left _ -> Nothing
+             Right obj -> do
+               access <- lookupObj obj "access_token"
+               refresh <- lookupObj obj "refresh_token"
+               Just $ ExternalToken (pack access) (pack refresh) 0 Github

api/src/OIDC/Twitter.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module OIDC.Github where
+import qualified Data.Text as T
+import qualified Data.HashMap.Strict as HM
+import qualified Data.ByteString.Char8 as B8
+
+import System.Environment.MrEnv ( envAsBool, envAsInt, envAsInteger, envAsString )
+import Network.HTTP.Simple (JSONException, parseRequest, setRequestMethod, addRequestHeader, setRequestQueryString, httpJSONEither, getResponseBody)
+import Data.Aeson.Types (Object, Value (String))
+import Data.Text ( Text, pack )
+import App (AppM)
+import Core.User (ExternalToken (ExternalToken), Service (Github))
+
+
+data GithubOAuth2 = GithubOAuth2
+                    { oauthClientId :: String
+                    , oauthClientSecret :: String
+                    , oauthOAuthorizeEndpoint :: String
+                    , oauthAccessTokenEndpoint :: String
+                    , oauthCallback :: String
+                    } deriving (Show, Eq)
+
+
+getGithubConfig :: IO GithubOAuth2
+getGithubConfig = GithubOAuth2
+            <$> envAsString "GITHUB_CLIENT_ID" ""
+            <*> envAsString "GITHUB_SECRET" ""
+            <*> pure "https://github.com/login/oauth/authorize"
+            <*> pure "https://github.com/login/oauth/access_token"
+            <*> pure "http://localhost:8080/auth/github/token"
+
+
+githubAuthEndpoint :: GithubOAuth2 -> String
+githubAuthEndpoint oa = concat  [ oauthOAuthorizeEndpoint oa
+                                , "?client_id=", oauthClientId oa
+                                , "&response_type=", "code"
+                                , "&redirect_uri=", oauthCallback oa]
+
+
+tokenEndpoint :: String -> GithubOAuth2 -> String
+tokenEndpoint code oa = concat  [ oauthAccessTokenEndpoint oa
+                                , "?client_id=", oauthClientId oa
+                                , "&client_secret=", oauthClientSecret oa
+                                , "&code=", code]
+
+
+lookupObj :: Object -> Text -> Maybe String
+lookupObj obj key = case HM.lookup key obj of
+                            Just (String x) -> Just . T.unpack $ x
+                            _ -> Nothing
+
+getGithubAuthEndpoint :: IO String
+getGithubAuthEndpoint = githubAuthEndpoint <$> getGithubConfig
+
+-- Step 3. Exchange code for auth token
+getGithubTokens :: String -> IO (Maybe ExternalToken)
+getGithubTokens code = do
+  gh <- getGithubConfig
+  let endpoint = tokenEndpoint code gh
+  request' <- parseRequest endpoint
+  let request = setRequestMethod "POST"
+                $ addRequestHeader "Accept" "application/json"
+                $ setRequestQueryString [ ("client_id", Just . B8.pack . oauthClientId $ gh)
+                                        , ("client_secret", Just . B8.pack . oauthClientSecret $ gh)
+                                        , ("code", Just . B8.pack $ code)]
+                $ request'
+  response <- httpJSONEither request
+  return $ case (getResponseBody response :: Either JSONException Object) of
+             Left _ -> Nothing
+             Right obj -> do
+               access <- lookupObj obj "access_token"
+               refresh <- lookupObj obj "refresh_token"
+               Just $ ExternalToken (pack access) (pack refresh) 0 Github

api/src/Utils.hs

@@ -1,4 +1,14 @@
 module Utils where
+import Data.Text (Text)
+import qualified Data.Text as T
+import qualified Data.HashMap.Strict as HM
+import Data.Aeson.Types (Object, Value (String))
 
 mapInd :: (a -> Int -> b) -> [a] -> [b]
-mapInd f l = zipWith f l [0..]
+mapInd f l = zipWith f l [0..]
+
+
+lookupObj :: Object -> Text -> Maybe String
+lookupObj obj key = case HM.lookup key obj of
+                            Just (String x) -> Just . T.unpack $ x
+                            _ -> Nothing