This commit is contained in:
nek0 2024-02-28 11:56:38 +01:00
parent 30ab4497f6
commit d0b6ffca7a
4 changed files with 21 additions and 25 deletions

View file

@ -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": {

View file

@ -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

View file

@ -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 $

View file

@ -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)))