From 3d0980811d61a78f265ec06dd5bd4ef2cde1cbdf Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Sun, 22 Jan 2023 01:37:20 +0100
Subject: oauth2 via uffd

this is unfortunately uffd-specific, since oauth2 is apparently sort of
a vague standard. But since it doesn't actually do much it should
probably be possible to make it fully configurable & generic if needed.
---
 lib/Config.hs | 32 ++++++++++++++++++++++++++++----
 1 file changed, 28 insertions(+), 4 deletions(-)

(limited to 'lib/Config.hs')

diff --git a/lib/Config.hs b/lib/Config.hs
index c76261e..65ac697 100644
--- a/lib/Config.hs
+++ b/lib/Config.hs
@@ -1,21 +1,31 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric   #-}
+{-# LANGUAGE RecordWildCards #-}
 -- |
 
 module Config where
-import           Conferer                 (DefaultConfig (configDef),
-                                           FromConfig)
+import           Conferer                 (DefaultConfig (configDef))
+import           Conferer.FromConfig
 import           Conferer.FromConfig.Warp ()
 import           Data.ByteString          (ByteString)
 import           Data.Text                (Text)
 import           GHC.Generics             (Generic)
 import           Network.Wai.Handler.Warp (Settings)
+import           URI.ByteString
+
+data UffdConfig = UffdConfig
+  { uffdConfigUrl          :: URIRef Absolute
+  , uffdConfigClientSecret :: Text
+  , uffdConfigClientName   :: Text
+  , uffdConfigEnable       :: Bool
+  } deriving (Generic, Show)
 
 data ServerConfig = ServerConfig
   { serverConfigWarp         :: Settings
   , serverConfigDbString     :: ByteString
   , serverConfigGtfs         :: FilePath
   , serverConfigZoneinfoPath :: FilePath
-  } deriving Generic
+  , serverConfigLogin        :: UffdConfig
+  } deriving (Generic)
 
 instance FromConfig ServerConfig
 
@@ -25,4 +35,18 @@ instance DefaultConfig ServerConfig where
     , serverConfigDbString = ""
     , serverConfigGtfs = "./gtfs.zip"
     , serverConfigZoneinfoPath = "/etc/zoneinfo/"
+    , serverConfigLogin = configDef
     }
+
+instance DefaultConfig UffdConfig where
+  configDef = UffdConfig uri "secret" "uffdclient" False
+    where Right uri = parseURI strictURIParserOptions "http://www.example.org"
+
+instance FromConfig UffdConfig where
+  fromConfig key config = do
+    url <- fetchFromConfig (key /. "url") config
+    let Right uffdConfigUrl = parseURI strictURIParserOptions url
+    uffdConfigClientName <- fetchFromConfig (key /. "clientName") config
+    uffdConfigClientSecret <- fetchFromConfig (key /. "clientSecret") config
+    uffdConfigEnable <- fetchFromConfig (key /. "enable") config
+    pure UffdConfig {..}
-- 
cgit v1.2.3