PWFile auth-plugin

This commit is contained in:
Gregor Kleen 2018-07-04 11:35:30 +02:00
parent 3f5fab8d2f
commit acd100bca7
8 changed files with 85 additions and 6 deletions

View File

@ -19,6 +19,7 @@ should-log-all: "_env:LOG_ALL:false"
# mutable-static: false
# skip-combining: false
auth-dummy-login: "_env:DUMMY_LOGIN:false"
auth-pwfile: "_env:PWFILE:"
allow-deprecated: "_env:ALLOW_DEPRECATED:false"
# NB: If you need a numeric value (e.g. 123) to parse as a String, wrap it in single quotes (e.g. "_env:PGPASS:'123'")

3
models
View File

@ -1,4 +1,4 @@
User
User json
plugin Text
ident Text
matrikelnummer Text Maybe
@ -8,6 +8,7 @@ User
theme Theme default='default'
UniqueAuthentication plugin ident
UniqueEmail email
deriving Show
UserAdmin
user UserId
school SchoolId

View File

@ -18,6 +18,7 @@ module Application
-- * for GHCI
, handler
, db
, addPWEntry
) where
import Control.Monad.Logger (liftLoc, runLoggingT)
@ -37,6 +38,15 @@ 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 qualified Data.ByteString.Char8 as BS
import qualified Data.Yaml as Yaml
-- Import all relevant handler modules here.
-- (HPack takes care to add new modules to our cabal file nowadays.)
import Handler.Common
@ -197,3 +207,14 @@ handler h = getAppDevSettings >>= makeFoundation >>= flip unsafeHandler h
-- | Run DB queries
db :: ReaderT SqlBackend (HandlerT UniWorX IO) a -> IO a
db = handler . runDB
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
c <- either (const []) id <$> Yaml.decodeFileEither pwFile
Yaml.encodeFile pwFile $ c ++ [pwEntry]

View File

@ -38,10 +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 qualified Data.CryptoID (CryptoID) -- for DisplayAble instance only
import qualified Data.ByteString.Base64.URL as Base64 (encode)
import qualified Data.ByteString.Base64.URL as Base64 (encode, decodeLenient)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as Lazy.ByteString
@ -74,6 +76,13 @@ import Handler.Utils.DateTime
import Control.Lens
import Utils.Lens
import Data.Aeson
import Data.Aeson.TH
import qualified Data.Yaml as Yaml
import Text.Shakespeare.Text (st)
-- -- TODO: Move the following to the appropriate place, if DisplayAble is kept
instance DisplayAble TermId where
@ -936,6 +945,14 @@ instance YesodAuth UniWorX where
-- Override the above two destinations when a Referer: header is present
redirectToReferer _ = True
loginHandler = do
tp <- getRouteToParent
lift . authLayout $ do
master <- getYesod
let authPlugins' = authPlugins master
$logDebugS "Auth" $ "Enabled plugins: " <> Text.intercalate ", " (map apName authPlugins')
forM_ authPlugins' $ flip apLogin tp
authenticate creds@(Creds{..}) = runDB . fmap (either id id) . runExceptT $ do
let (userPlugin, userIdent)
| isDummy
@ -944,11 +961,12 @@ instance YesodAuth UniWorX where
| otherwise
= (credsPlugin, credsIdent)
isDummy = credsPlugin == "dummy"
isPWFile = credsPlugin == "PWFile"
uAuth = UniqueAuthentication userPlugin userIdent
$logDebugS "auth" $ tshow ((userPlugin, userIdent), creds)
when isDummy . (throwError =<<) . lift $
when (isDummy || isPWFile) . (throwError =<<) . lift $
maybe (UserError $ IdentifierNotFound credsIdent) (Authenticated . entityKey) <$> getBy uAuth
let
@ -991,9 +1009,38 @@ instance YesodAuth UniWorX where
authPlugins app = [genericAuthLDAP $ ldapConfig app] ++ extraAuthPlugins
-- Enable authDummy login if enabled.
where extraAuthPlugins = [authDummy | appAuthDummyLogin $ appSettings app]
++ [authPWFile fp | fp <- maybeToList . appAuthPWFile $ appSettings app]
authHttpManager = getHttpManager
authPWFile :: FilePath -> AuthPlugin UniWorX
authPWFile fp = AuthPlugin{..}
where
apName = "PWFile"
apLogin = mempty
apDispatch "GET" [] = do
authData <- lookupBasicAuth
pwdata <- liftIO $ Yaml.decodeFileEither fp
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) } ]
<- [ pwe | pwe@PWEntry{..} <- pwdata'
, let User{..} = pwUser
, userIdent == usr
, userPlugin == apName
]
, CryptoPassed hash <- Argon2.hash Argon2.defaultOptions pw pwSalt 256
, hash == pwHash
-> lift $ do
runDB . void $ insertUnique pwUser
setCredsRedirect $ Creds apName userIdent []
| otherwise -> permissionDenied "Invalid auth"
apDispatch _ _ = notFound
ldapConfig :: UniWorX -> LDAPConfig
ldapConfig _app@(appSettings -> settings) = LDAPConfig
{ usernameFilter = \u -> principalName <> "=" <> u

View File

@ -17,6 +17,7 @@ import Database.Persist.Quasi
-- import Data.Time
-- import Data.ByteString
import Model.Types
import Data.Aeson.TH
-- You can define all of your database entities in the entities file.
-- You can find more information on persistent and how to declare entities
@ -25,5 +26,8 @@ import Model.Types
share [mkPersist sqlSettings, mkDeleteCascade sqlSettings, mkMigrate "migrateAll"]
$(persistFileWith lowerCaseSettings "models")
data PWEntry = PWEntry
{ pwUser :: User
, pwSalt, pwHash :: Text
} deriving (Show)
$(deriveJSON defaultOptions ''PWEntry)

View File

@ -262,6 +262,7 @@ data Theme --Simply add Themes to this type only. CamelCase will be conver
| SkyLove
deriving (Eq,Ord,Bounded,Enum)
$(deriveJSON defaultOptions ''Theme)
$(deriveShowWith uncamel ''Theme) -- show for internal use in css/js
$(deriveSimpleWith ''DisplayAble 'display camelSpace ''Theme) -- display to display at user

View File

@ -71,6 +71,8 @@ data AppSettings = AppSettings
, appAuthDummyLogin :: Bool
-- ^ Indicate if auth dummy login should be enabled.
, appAuthPWFile :: Maybe FilePath
-- ^ If set authenticate against a local password file
, appAllowDeprecated :: Bool
-- ^ Indicate if deprecated routes are accessible for everyone
}
@ -106,6 +108,7 @@ instance FromJSON AppSettings where
appCryptoIDKeyFile <- o .: "cryptoid-keyfile"
appAuthDummyLogin <- o .:? "auth-dummy-login" .!= defaultDev
appAuthPWFile <- ((\f -> f <$ guard (not $ null f)) =<<) <$> o .:? "auth-pwfile"
appAllowDeprecated <- o .:? "allow-deprecated" .!= defaultDev
return AppSettings {..}

View File

@ -5,5 +5,6 @@ export DETAILED_LOGGING=true
export LOG_ALL=true
export DUMMY_LOGIN=true
export ALLOW_DEPRECATED=true
export PWFILE=users.yml
exec -- stack exec -- yesod devel