diff options
author | Ben Sima <ben@bsima.me> | 2021-08-23 13:06:15 -0400 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2021-11-26 13:47:38 -0500 |
commit | 45f352f9cb3bdc16048a0f0d70eef6a59272472b (patch) | |
tree | 7cae4b608e45360085d950d7c14d80911ce46b7c /Biz/Auth.hs | |
parent | aa2eb2d3e08fb74b93acc9608a78582834a65e8c (diff) |
Fix GitHub OAuth args
This makes it explicit that we are using GitHub vs some other OAuth args. The
idea is that we should be making a new type for every service, this allows us to
have type safety in the implementation but a common set or pattern of names for
the environment variables and record fields.
Also using 'notset' instead of 'mempty' is really helpful for debugging when
this breaks, as I found out.
Diffstat (limited to 'Biz/Auth.hs')
-rw-r--r-- | Biz/Auth.hs | 45 |
1 files changed, 40 insertions, 5 deletions
diff --git a/Biz/Auth.hs b/Biz/Auth.hs index ed904b9..1c3e45c 100644 --- a/Biz/Auth.hs +++ b/Biz/Auth.hs @@ -13,6 +13,7 @@ module Biz.Auth OAuthArgs (..), -- * GitHub Authentication + GitHub (..), githubOauth, -- * Servant Helpers @@ -28,6 +29,10 @@ 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 = @@ -45,9 +50,9 @@ data OAuthArgs = OAuthArgs instance Envy.DefConfig OAuthArgs where defConfig = OAuthArgs - { clientSecret = mempty, - clientId = mempty, - clientState = mempty + { clientSecret = notset, + clientId = notset, + clientState = notset } instance Envy.FromEnv OAuthArgs @@ -61,13 +66,43 @@ data OAuthResponse = OAuthResponse } 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 :: - OAuthArgs -> + GitHub -> -- | This should be GitHub.Token but GitHub.Auth doesn't export Token. Text -> IO OAuthResponse -githubOauth OAuthArgs {..} code = +githubOauth (GitHub OAuthArgs {..}) code = accessTokenRequest /> Req.responseBody |> Req.runReq Req.defaultHttpConfig |