From d0b6ffca7a6c4d9333b3dd67dc9f4f8c09d08b94 Mon Sep 17 00:00:00 2001 From: nek0 Date: Wed, 28 Feb 2024 11:56:38 +0100 Subject: [PATCH] meow --- flake.lock | 18 +++++++++--------- src/ClientAuth.hs | 4 ++-- src/Control/User.hs | 20 ++++++++------------ src/Util.hs | 4 ++-- 4 files changed, 21 insertions(+), 25 deletions(-) diff --git a/flake.lock b/flake.lock index cb695f7..ad67e6b 100644 --- a/flake.lock +++ b/flake.lock @@ -5,11 +5,11 @@ "systems": "systems" }, "locked": { - "lastModified": 1689068808, - "narHash": "sha256-6ixXo3wt24N/melDWjq70UuHQLxGV8jZvooRanIHXw0=", + "lastModified": 1705309234, + "narHash": "sha256-uNRRNRKmJyCRC/8y1RqBkqWBLM034y4qN7EprSdmgyA=", "owner": "numtide", "repo": "flake-utils", - "rev": "919d646de7be200f3bf08cb76ae1f09402b6f9b4", + "rev": "1ef2e671c3b0c19053962c07dbda38332dcebf26", "type": "github" }, "original": { @@ -28,10 +28,10 @@ ] }, "locked": { - "lastModified": 1689698775, - "narHash": "sha256-N/PXBoXEN07oTWQto3KfwNe03jwRCoz4hyyFOL3J/8E=", + "lastModified": 1709116606, + "narHash": "sha256-eFkahVy1E25k2xrozWg8pFuuAZJc9TXU0i7LnnRlp+Y=", "ref": "refs/heads/master", - "rev": "fa7df22fafaeb42b82da8dc2b37abd521c4ff603", + "rev": "f2b7b60231e6f465eb0a28fc30f7b7f73a7b73ae", "revCount": 293, "type": "git", "url": "https://gitea.nek0.eu/nek0/mateamt" @@ -43,11 +43,11 @@ }, "nixpkgs": { "locked": { - "lastModified": 1689698611, - "narHash": "sha256-guhcA85PsFOuU/GhD6zE/5CqjYtEjvciIaUO50CyqIg=", + "lastModified": 1709116111, + "narHash": "sha256-V7BbC39cGDOzJsCsmg+hCdBu1Tuhqs7kLcPxw86STh4=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "858583786239c23cfb56c50e858581d7d8bb3b40", + "rev": "b84d9f029fa675d5ef312f032f322889149daa82", "type": "github" }, "original": { diff --git a/src/ClientAuth.hs b/src/ClientAuth.hs index a8d23d6..8adab96 100644 --- a/src/ClientAuth.hs +++ b/src/ClientAuth.hs @@ -6,10 +6,10 @@ module ClientAuth where import Servant.API (AuthProtect) import Servant.Client.Core -type instance AuthClientData (AuthProtect "header-auth") = String +type instance AuthClientData (AuthProtect "Bearer") = String authenticateReq :: String -> Request -> Request -authenticateReq = addHeader "Authentication" +authenticateReq = addHeader "Bearer" nonAuthenticateRequest :: String -> Request -> Request nonAuthenticateRequest _ = id diff --git a/src/Control/User.hs b/src/Control/User.hs index 79146a3..c92a691 100644 --- a/src/Control/User.hs +++ b/src/Control/User.hs @@ -41,9 +41,9 @@ userSelectControl -> Maybe MT.UserRefine -> UserHandler UserSelectPage userSelectControl mcookie mrefine = do - (ReadState l10n backend _ symbol version) <- ask + (ReadState l10n backend _ _ version) <- ask let loc = Locale - (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie) + (fromMaybe "en" $ lookup "locale" . parseCookieText =<< mcookie) euser <- liftIO $ runClientM (userList mrefine) backend @@ -55,22 +55,19 @@ userSelectControl mcookie mrefine = do userNewControl :: Maybe T.Text -> UserHandler UserNewPage userNewControl mcookie = do - (ReadState l10n _ _ symbol version) <- ask + (ReadState l10n _ _ _ version) <- ask let loc = Locale - (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie) + (fromMaybe "en" $ lookup "locale" . parseCookieText =<< mcookie) return $ userNewPage l10n loc version mcookie userNewPostControl :: Maybe T.Text -> MT.UserSubmit -> UserHandler UserSelectPage -userNewPostControl _ us@(MT.UserSubmit _ _ pass) = do +userNewPostControl _ us = do backend <- asks rsBackend - hashedPass <- hashPassword pass void $ liftIO $ runClientM - (userNew $us - { MT.userSubmitPassHash = hashedPass - }) + (userNew us) backend throwError $ redirect303 (userSelectLink Nothing) @@ -149,8 +146,7 @@ userRechargeControl -> Int -> UserHandler UserRechargePage userRechargeControl mcookie uid = do - l10n <- asks rsL10n - (ReadState l10n backend _ symbol version) <- ask + (ReadState l10n _ _ symbol version) <- ask let loc = localeFromCookie mcookie return $ userRechargePage l10n loc version mcookie uid symbol @@ -189,7 +185,7 @@ userManageControl -> Int -> UserHandler UserManagePage userManageControl mcookie uid = do - (ReadState l10n backend _ symbol version) <- ask + (ReadState l10n backend _ _ version) <- ask let loc = localeFromCookie mcookie (token, mAuthUser) = parseTokenAndUser mcookie eUserDetails <- liftIO $ diff --git a/src/Util.hs b/src/Util.hs index afcedfc..1757d30 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -99,7 +99,7 @@ parseTokenAndUser mcookie = where token = T.unpack $ fromMaybe "secret" (lookup "x-token" =<< mParsedCookie) - mAuthUser = read <$> T.unpack <$> + mAuthUser = read . T.unpack <$> (lookup "x-auth-user" =<< mParsedCookie) mParsedCookie = fmap parseCookieText mcookie @@ -107,7 +107,7 @@ localeFromCookie :: Maybe T.Text -> Locale localeFromCookie mcookie = Locale - (fromMaybe "en" $ lookup "locale" =<< fmap parseCookieText mcookie) + (fromMaybe "en" $ lookup "locale" . parseCookieText =<< mcookie) handleErrors :: (Traversable t, Show (t (Maybe ClientError)))