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.

1 files changed, 141 insertions, 0 deletions

diff --git a/Omni/Auth.hs b/Omni/Auth.hs
new file mode 100644
index 0000000..0f1cb66
--- /dev/null
+++ b/Omni/Auth.hs
@@ -0,0 +1,141 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+-- | A module for common OAuth flows.
+--
+-- Consider using authenticate-oauth package
+module Omni.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 Omni.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