From a3991ddb8f61955c5c48ac99b6eed14d5e9f986a Mon Sep 17 00:00:00 2001 From: LLLL Colonq Date: Thu, 14 Nov 2024 21:20:28 -0500 Subject: Account creation in LDAP using Twitch --- fig-web/fig-web.cabal | 3 +++ fig-web/src/Fig/Web.hs | 20 +++++++++++++++----- fig-web/src/Fig/Web/Auth.hs | 3 +-- fig-web/src/Fig/Web/LDAP.hs | 39 +++++++++++++++++++++++++++++++++++++++ fig-web/src/Fig/Web/Utils.hs | 10 ++++++++++ flake.nix | 22 ++++++++++++++++++++++ 6 files changed, 90 insertions(+), 7 deletions(-) create mode 100644 fig-web/src/Fig/Web/LDAP.hs diff --git a/fig-web/fig-web.cabal b/fig-web/fig-web.cabal index 600d4d8..0b8aa8e 100644 --- a/fig-web/fig-web.cabal +++ b/fig-web/fig-web.cabal @@ -29,6 +29,7 @@ common deps , megaparsec , mtl , network + , process , random , req , safe-exceptions @@ -38,6 +39,7 @@ common deps , tomland , transformers , unordered-containers + , uuid , vector , wai , wai-extra @@ -60,6 +62,7 @@ library Fig.Web.Auth Fig.Web.State Fig.Web.DB + Fig.Web.LDAP executable fig-web import: defaults diff --git a/fig-web/src/Fig/Web.hs b/fig-web/src/Fig/Web.hs index 5065378..5d32f75 100644 --- a/fig-web/src/Fig/Web.hs +++ b/fig-web/src/Fig/Web.hs @@ -18,7 +18,7 @@ import qualified Data.ByteString.Base64 as BS.Base64 import qualified Data.Set as Set import qualified Network.Wai as Wai --- import qualified Network.Wai.Middleware.Static as Wai.Static +import qualified Network.Wai.Middleware.Static as Wai.Static import qualified Network.Wai.Handler.Warp as Warp import qualified Network.WebSockets as WS @@ -30,6 +30,7 @@ import Fig.Web.Utils import Fig.Web.Auth import Fig.Web.State import qualified Fig.Web.DB as DB +import qualified Fig.Web.LDAP as LDAP data LiveEvent = LiveEventOnline !(Set.Set Text) @@ -51,14 +52,14 @@ server cfg busAddr = do case d of SExprList (ev:rest) | ev == [sexp|(monitor twitch stream online)|] -> do - let live = mapMaybe (\case SExprString s -> Just s; _ -> Nothing) rest + let live = mapMaybe (\case SExprString s -> Just s; _other -> Nothing) rest let new = Set.fromList live old <- MVar.swapMVar currentlyLive new let online = Set.difference new old let offline = Set.difference old new unless (Set.null online) . Chan.writeChan liveEvents $ LiveEventOnline online unless (Set.null offline) . Chan.writeChan liveEvents $ LiveEventOnline offline - _ -> log $ "Invalid event: " <> tshow d + _other -> log $ "Invalid event: " <> tshow d ) (pure ()) @@ -72,8 +73,9 @@ app cfg cmds liveEvents currentlyLive = do log "Connected! Server active." st <- stateRef Sc.scottyApp do - -- Sc.middleware $ Wai.Static.staticPolicy $ Wai.Static.addBase cfg.assetPath - Sc.get "/" $ Sc.redirect "/index.html" + Sc.middleware $ Wai.Static.staticPolicy $ Wai.Static.addBase cfg.assetPath + Sc.get "/register" do + Sc.redirect "/register.html" Sc.get "/unauthorized" do Sc.status status401 Sc.text $ mconcat @@ -90,6 +92,14 @@ app cfg cmds liveEvents currentlyLive = do , "for example:\n" , " curl https://secure.colonq.computer --cookie cookies.txt\n" ] + Sc.get "/api/register" $ authed cfg \auth -> do + let user = Text.toLower auth.name + LDAP.resetUserPassword cfg user auth.id >>= \case + Nothing -> do + Sc.status status500 + Sc.text "failed to register" + Just pass -> do + Sc.text . Text.L.fromStrict $ user <> " " <> pass Sc.get "/api/check" $ authed cfg \auth -> do Sc.json @[Text] [auth.id, auth.name] Sc.put "/api/buffer" do diff --git a/fig-web/src/Fig/Web/Auth.hs b/fig-web/src/Fig/Web/Auth.hs index 3076d1f..2fb23b9 100644 --- a/fig-web/src/Fig/Web/Auth.hs +++ b/fig-web/src/Fig/Web/Auth.hs @@ -15,7 +15,6 @@ import qualified Jose.Jwk as Jwk import qualified Jose.Jwt as Jwt import qualified Web.Scotty as Sc -import qualified Web.Scotty.Cookie as Sc.C import Fig.Web.Utils @@ -65,7 +64,7 @@ checkAuth cfg = let pairs = Map.fromList $ flip mapMaybe authstr \s -> case Text.splitOn "=" s of [k, v] -> Just (k, Text.takeWhile (/='"') $ Text.drop 1 v) - _ -> Nothing + _other -> Nothing case (Map.lookup "token" pairs, Map.lookup "nonce" pairs) of (Just token, Just nonce) -> do log $ tshow token diff --git a/fig-web/src/Fig/Web/LDAP.hs b/fig-web/src/Fig/Web/LDAP.hs new file mode 100644 index 0000000..e9861a9 --- /dev/null +++ b/fig-web/src/Fig/Web/LDAP.hs @@ -0,0 +1,39 @@ +module Fig.Web.LDAP where + +import Fig.Prelude + +import System.Exit (ExitCode(..)) +import qualified System.Process as Proc + +import qualified Data.UUID as UUID +import qualified Data.UUID.V4 as UUID +import qualified Data.Text as Text + +import Fig.Web.Utils + +-- | Reset the password in LDAP for the specified user (creating the user if necessary) +resetUserPassword :: MonadIO m => Config -> Text -> Text -> m (Maybe Text) +resetUserPassword cfg user uid = do + let login = Text.toLower user + password <- UUID.toText <$> liftIO UUID.nextRandom + exitCode <- liftIO $ Proc.withCreateProcess + (Proc.proc cfg.lldapCli $ unpack <$> + [ "-H", cfg.lldapHost + , "-D", cfg.lldapUser + , "-w", cfg.lldapPassword + , "user", "add", login, login <> "@users.colonq.computer" + , "-p", password + , "-f", uid + ]) + \_ _ _ h -> Proc.waitForProcess h + liftIO $ Proc.withCreateProcess + (Proc.proc cfg.lldapCli $ unpack <$> + [ "-H", cfg.lldapHost + , "-D", cfg.lldapUser + , "-w", cfg.lldapPassword + , "user", "group", "add", login, "fig_users" + ]) + \_ _ _ h -> void $ Proc.waitForProcess h + case exitCode of + ExitSuccess -> pure $ Just password + ExitFailure _ -> pure Nothing diff --git a/fig-web/src/Fig/Web/Utils.hs b/fig-web/src/Fig/Web/Utils.hs index b6c385a..004ba5a 100644 --- a/fig-web/src/Fig/Web/Utils.hs +++ b/fig-web/src/Fig/Web/Utils.hs @@ -25,17 +25,27 @@ instance Exception FigWebException data Config = Config { port :: !Int + , assetPath :: !FilePath , clientId :: !Text , authToken :: !Text , dbHost :: !Text + , lldapCli :: !FilePath + , lldapHost :: !Text + , lldapUser :: !Text + , lldapPassword :: !Text } deriving (Show, Eq, Ord) configCodec :: Toml.TomlCodec Config configCodec = do port <- Toml.int "port" Toml..= (\a -> a.port) + assetPath <- Toml.string "asset_path" Toml..= (\a -> a.assetPath) clientId <- Toml.text "client_id" Toml..= (\a -> a.clientId) authToken <- Toml.text "auth_token" Toml..= (\a -> a.authToken) dbHost <- Toml.text "db_host" Toml..= (\a -> a.dbHost) + lldapCli <- Toml.string "lldap_cli" Toml..= (\a -> a.lldapCli) + lldapHost <- Toml.text "lldap_host" Toml..= (\a -> a.lldapHost) + lldapUser <- Toml.text "lldap_user" Toml..= (\a -> a.lldapUser) + lldapPassword <- Toml.text "lldap_password" Toml..= (\a -> a.lldapPassword) pure $ Config{..} loadConfig :: FilePath -> IO Config diff --git a/flake.nix b/flake.nix index 1add11b..36e5161 100644 --- a/flake.nix +++ b/flake.nix @@ -10,6 +10,25 @@ system = "x86_64-linux"; pkgs = nixpkgs.legacyPackages.${system}; + lldap-cli = pkgs.stdenv.mkDerivation { + name = "lldap-cli"; + src = pkgs.fetchFromGitHub { + owner = "Zepmann"; + repo = "lldap-cli"; + rev = "2a80dc4"; + sha256 = "uk7SOiQmUYtoJnihSnPsu/7Er4wXX4xvPboJaNSMjkM="; + }; + buildPhase = ""; + installPhase = '' + mkdir -p $out/bin + cp lldap-cli $out/bin + ''; + }; + lldap-cli-wrapped = pkgs.writeShellScriptBin "lldap-cli" '' + export PATH=${pkgs.lldap}/bin:$PATH + ${lldap-cli}/bin/lldap-cli "$@" + ''; + haskellOverrides = self: super: { scotty = self.callHackageDirect { pkg = "scotty"; @@ -273,6 +292,7 @@ description = "Path to config file"; default = pkgs.writeText "fig-web.toml" '' port = 8000 + asset_path = "/var/lib/fig-web-assets" client_id = "" auth_token = "" db_host = "" @@ -317,6 +337,7 @@ description = "Path to config file"; default = pkgs.writeText "fig-web-secure.toml" '' port = 8000 + asset_path = "/var/lib/fig-web-assets" client_id = "" auth_token = "" db_host = "" @@ -356,6 +377,7 @@ ]; withHoogle = true; buildInputs = [ + lldap-cli-wrapped haskellPackages.cabal-install haskellPackages.haskell-language-server pkgs.nodejs -- cgit v1.2.3