diff --git a/config/settings.yml b/config/settings.yml index 51966ee5d..c3ff0ecf3 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -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'") diff --git a/models b/models index 61bb54563..e264d3192 100644 --- a/models +++ b/models @@ -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 diff --git a/src/Application.hs b/src/Application.hs index 3f7d3139a..37ba273b9 100644 --- a/src/Application.hs +++ b/src/Application.hs @@ -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] diff --git a/src/Foundation.hs b/src/Foundation.hs index 61720964e..b9a042343 100644 --- a/src/Foundation.hs +++ b/src/Foundation.hs @@ -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 diff --git a/src/Model.hs b/src/Model.hs index a08615827..538a675cc 100644 --- a/src/Model.hs +++ b/src/Model.hs @@ -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) diff --git a/src/Model/Types.hs b/src/Model/Types.hs index f202f6eb9..26daaa8b3 100644 --- a/src/Model/Types.hs +++ b/src/Model/Types.hs @@ -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 diff --git a/src/Settings.hs b/src/Settings.hs index 3d9baa11b..77276f6e0 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -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 {..} diff --git a/start.sh b/start.sh index f55acbcae..b73e8bc05 100755 --- a/start.sh +++ b/start.sh @@ -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