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, import System.Log.FastLogger (defaultBufSize, newStdoutLoggerSet,
toLogStr) 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 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.ByteString.Char8 as BS
import qualified Data.Yaml as Yaml import qualified Data.Yaml as Yaml
@ -212,9 +209,8 @@ addPWEntry :: FilePath {-^ Password file -}
-> User -> User
-> Text {-^ Password -} -> Text {-^ Password -}
-> IO () -> IO ()
addPWEntry pwFile pwUser (Text.encodeUtf8 -> pw) = do addPWEntry pwFile pwUser' (Text.encodeUtf8 -> pw) = do
pwSalt'@(Text.decodeUtf8 . Base64.encode -> pwSalt) <- getRandomBytes 32 (Text.decodeUtf8 -> pwHash) <- makePassword pw 14
let pwEntry = PWEntry{..} let pwEntry = PWEntry{ pwUser = pwUser', .. }
CryptoPassed (Text.decodeUtf8 . Base64.encode -> pwHash) = Argon2.hash Argon2.defaultOptions pw pwSalt' 256
c <- either (const []) id <$> Yaml.decodeFileEither pwFile 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 Data.ByteArray (convert)
import Crypto.Hash (Digest, SHAKE256) import Crypto.Hash (Digest, SHAKE256)
import Crypto.Hash.Conduit (sinkHash) 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.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 Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as Lazy.ByteString import qualified Data.ByteString.Lazy as Lazy.ByteString
@ -1020,24 +1020,28 @@ authPWFile fp = AuthPlugin{..}
apDispatch "GET" [] = do apDispatch "GET" [] = do
authData <- lookupBasicAuth authData <- lookupBasicAuth
pwdata <- liftIO $ Yaml.decodeFileEither fp 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 case (authData, pwdata) of
(_, Left _) -> permissionDenied "Invalid password file"
(Nothing, _) -> do (Nothing, _) -> do
addHeader "WWW-Authenticate" [st|Basic realm="uni2work maintenance auth" charset="UTF-8"|]
notAuthenticated notAuthenticated
(Just (usr, (Text.encodeUtf8 -> pw)), Right pwdata') (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' <- [ pwe | pwe@PWEntry{..} <- pwdata'
, let User{..} = pwUser , let User{..} = pwUser
, userIdent == usr , userIdent == usr
, userPlugin == apName , userPlugin == apName
] ]
, CryptoPassed hash <- Argon2.hash Argon2.defaultOptions pw pwSalt 256 , verifyPassword pw pwHash
, hash == pwHash
-> lift $ do -> lift $ do
runDB . void $ insertUnique pwUser runDB . void $ insertUnique pwUser
setCredsRedirect $ Creds apName userIdent [] setCredsRedirect $ Creds apName userIdent []
| otherwise -> permissionDenied "Invalid auth" _ -> permissionDenied "Invalid auth"
apDispatch _ _ = notFound apDispatch _ _ = notFound

2
src/Model.hs
View File

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