summaryrefslogtreecommitdiff
path: root/Biz/Auth.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2024-11-15 14:55:37 -0500
committerBen Sima <ben@bsima.me>2024-12-21 10:06:49 -0500
commit6513755670892983db88a6633b8c1ea6019c03d1 (patch)
tree44e9eccdb7a3a74ab7e96a8fee7572dd6a78dc73 /Biz/Auth.hs
parentae7b7e0186b5f2e0dcd4d5fac0a71fa264caedc2 (diff)
Re-namespace some stuff to Omni
I was getting confused about what is a product and what is internal infrastructure; I think it is good to keep those things separate. So I moved a bunch of stuff to an Omni namespace, actually most stuff went there. Only things that are explicitly external products are still in the Biz namespace.
Diffstat (limited to 'Biz/Auth.hs')
-rw-r--r--Biz/Auth.hs141
1 files changed, 0 insertions, 141 deletions
diff --git a/Biz/Auth.hs b/Biz/Auth.hs
deleted file mode 100644
index 73022d7..0000000
--- a/Biz/Auth.hs
+++ /dev/null
@@ -1,141 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE RecordWildCards #-}
-
--- | A module for common OAuth flows.
---
--- Consider using authenticate-oauth package
-module Biz.Auth
- ( -- * OAuth
- OAuthResponse (..),
- OAuthArgs (..),
-
- -- * GitHub Authentication
- GitHub (..),
- githubOauth,
-
- -- * Servant Helpers
- SetCookies,
- liveCookieSettings,
- testCookieSettings,
- )
-where
-
-import Alpha
-import qualified Data.Aeson as Aeson
-import Network.HTTP.Req ((/:), (=:))
-import qualified Network.HTTP.Req as Req
-import Servant (Header, Headers)
-import qualified Servant.Auth.Server as Auth
-import qualified System.Envy as Envy
-
--- | Use this instead of 'mempty' for explicity.
-notset :: Text
-notset = "notset"
-
--- | Wrapper around 'Auth.SetCookie' that you can put in a servant path
--- descriptor.
-type SetCookies ret =
- (Headers '[Header "Set-Cookie" Auth.SetCookie, Header "Set-Cookie" Auth.SetCookie] ret)
-
-liveCookieSettings :: Auth.CookieSettings
-liveCookieSettings =
- Auth.defaultCookieSettings
- { Auth.cookieIsSecure = Auth.Secure,
- -- disable XSRF protection because we don't use any javascript
- Auth.cookieXsrfSetting = Nothing
- }
-
-testCookieSettings :: Auth.CookieSettings
-testCookieSettings =
- Auth.defaultCookieSettings
- { Auth.cookieIsSecure = Auth.NotSecure,
- Auth.cookieXsrfSetting = Nothing
- }
-
--- | These are arguments that a 3rd-party OAuth provider needs in order for us
--- to authenticate a user.
-data OAuthArgs = OAuthArgs
- { clientSecret :: Text,
- clientId :: Text,
- clientState :: Text
- }
- deriving (Generic, Show)
-
-instance Envy.DefConfig OAuthArgs where
- defConfig =
- OAuthArgs
- { clientSecret = notset,
- clientId = notset,
- clientState = notset
- }
-
-instance Envy.FromEnv OAuthArgs
-
--- | A type for parsing JSON auth responses, used in 'githubOauth' below.
--- Should be moved to Biz.Auth with others.
-data OAuthResponse = OAuthResponse
- { access_token :: Text,
- scope :: Text,
- token_type :: Text
- }
- deriving (Generic, Aeson.FromJSON)
-
-newtype GitHub = GitHub OAuthArgs
- deriving (Show, Generic)
-
-instance Envy.DefConfig GitHub where
- defConfig =
- GitHub
- <| OAuthArgs
- { clientSecret = notset,
- clientId = notset,
- clientState = notset
- }
-
-instance Envy.FromEnv GitHub where
- fromEnv Nothing =
- GitHub
- </ Envy.gFromEnvCustom
- Envy.Option
- { Envy.dropPrefixCount = 0,
- Envy.customPrefix = "GITHUB"
- }
- Nothing
- fromEnv (Just (GitHub x)) =
- GitHub
- </ Envy.gFromEnvCustom
- Envy.Option
- { Envy.dropPrefixCount = 0,
- Envy.customPrefix = "GITHUB"
- }
- (Just x)
-
--- | POST to GitHub's OAuth service and get the user's oAuth token.
-githubOauth ::
- GitHub ->
- -- | This should be GitHub.Token but GitHub.Auth doesn't export Token.
- Text ->
- IO OAuthResponse
-githubOauth (GitHub OAuthArgs {..}) code =
- accessTokenRequest
- /> Req.responseBody
- |> Req.runReq Req.defaultHttpConfig
- where
- accessTokenRequest :: Req.Req (Req.JsonResponse OAuthResponse)
- accessTokenRequest =
- Req.req
- Req.POST
- (Req.https "github.com" /: "login" /: "oauth" /: "access_token")
- Req.NoReqBody
- Req.jsonResponse
- <| "client_id"
- =: clientId
- <> "client_secret"
- =: clientSecret
- <> "code"
- =: code
- <> "state"
- =: clientState