fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use canned password management instead of implementing our own

Browse Source
This commit is contained in:
Gregor Kleen 2018-07-04 12:01:57 +02:00
parent acd100bca7
commit 523282e694
3 changed files with 19 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/Application.hs
View File

@ -38,11 +38,8 @@ import Network.Wai.Middleware.RequestLogger (Destination (Logger),
import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
toLogStr)
import qualified Crypto.KDF.Argon2 as Argon2
import Crypto.Error (CryptoFailable(..))
import qualified Data.ByteString.Base64.URL as Base64 (encode)
import qualified Data.Text.Encoding as Text
import Crypto.Random (MonadRandom(..))
import Yesod.Auth.Util.PasswordStore
import qualified Data.ByteString.Char8 as BS
import qualified Data.Yaml as Yaml
@ -212,9 +209,8 @@ addPWEntry :: FilePath {-^ Password file -}
-> User
-> Text {-^ Password -}
-> IO ()
addPWEntry pwFile pwUser (Text.encodeUtf8 -> pw) = do
pwSalt'@(Text.decodeUtf8 . Base64.encode -> pwSalt) <- getRandomBytes 32
let pwEntry = PWEntry{..}
CryptoPassed (Text.decodeUtf8 . Base64.encode -> pwHash) = Argon2.hash Argon2.defaultOptions pw pwSalt' 256
addPWEntry pwFile pwUser' (Text.encodeUtf8 -> pw) = do
(Text.decodeUtf8 -> pwHash) <- makePassword pw 14
let pwEntry = PWEntry{ pwUser = pwUser', .. }
c <- either (const []) id <$> Yaml.decodeFileEither pwFile
Yaml.encodeFile pwFile $ c ++ [pwEntry]
Yaml.encodeFile pwFile $ pwEntry : [ c' | c' <- c, ((/=) `on` (userIdent . pwUser)) c' pwEntry ]

22
src/Foundation.hs
View File

@ -38,12 +38,12 @@ import qualified Data.Text.Encoding as TE
import Data.ByteArray (convert)
import Crypto.Hash (Digest, SHAKE256)
import Crypto.Hash.Conduit (sinkHash)
import qualified Crypto.KDF.Argon2 as Argon2
import Crypto.Error (CryptoFailable(..))
import Yesod.Auth.Util.PasswordStore
import qualified Data.CryptoID (CryptoID) -- for DisplayAble instance only
import qualified Data.ByteString.Base64.URL as Base64 (encode, decodeLenient)
import qualified Data.ByteString.Base64.URL as Base64 (encode)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as Lazy.ByteString
@ -1020,24 +1020,28 @@ authPWFile fp = AuthPlugin{..}
apDispatch "GET" [] = do
authData <- lookupBasicAuth
pwdata <- liftIO $ Yaml.decodeFileEither fp
addHeader "WWW-Authenticate" [st|Basic realm="uni2work maintenance auth" charset="UTF-8"|]
case pwdata of
Left err -> $logDebugS "Auth" $ tshow err
Right pws -> $logDebugS "Auth" $ tshow (length pws) <> " pw entries"
case (authData, pwdata) of
(_, Left _) -> permissionDenied "Invalid password file"
(Nothing, _) -> do
addHeader "WWW-Authenticate" [st|Basic realm="uni2work maintenance auth" charset="UTF-8"|]
notAuthenticated
(Just (usr, (Text.encodeUtf8 -> pw)), Right pwdata')
| [ PWEntry{ pwUser = pwUser@(User{..}), pwHash = (Base64.decodeLenient . Text.encodeUtf8 -> pwHash), pwSalt = (Base64.decodeLenient . Text.encodeUtf8 -> pwSalt) } ]
| [ PWEntry{ pwUser = pwUser@(User{..}), pwHash = (Text.encodeUtf8 -> pwHash) } ]
<- [ pwe | pwe@PWEntry{..} <- pwdata'
, let User{..} = pwUser
, userIdent == usr
, userPlugin == apName
]
, CryptoPassed hash <- Argon2.hash Argon2.defaultOptions pw pwSalt 256
, hash == pwHash
, verifyPassword pw pwHash
-> lift $ do
runDB . void $ insertUnique pwUser
setCredsRedirect $ Creds apName userIdent []
| otherwise -> permissionDenied "Invalid auth"
_ -> permissionDenied "Invalid auth"
apDispatch _ _ = notFound

2
src/Model.hs
View File

@ -28,6 +28,6 @@ share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll
data PWEntry = PWEntry
{ pwUser :: User
, pwSalt, pwHash :: Text
, pwHash :: Text
} deriving (Show)
$(deriveJSON defaultOptions ''PWEntry)