0.2.5 initial commit

Makefile incomplete

agent/src/Lib/Password.hs

@@ -0,0 +1,77 @@
+module Lib.Password where
+
+import           Startlude
+import           Yesod.Auth.Util.PasswordStore  ( makePassword
+                                                , verifyPassword
+                                                , passwordStrength
+                                                )
+import qualified Data.ByteString.Char8         as BS
+                                                ( pack
+                                                , unpack
+                                                )
+import           Data.Text                      ( pack
+                                                , unpack
+                                                )
+
+import           Model
+
+-- Root account identifier
+rootAccountName :: Text
+rootAccountName = "embassy-root"
+
+
+-- | Default strength used for passwords (see "Yesod.Auth.Util.PasswordStore"
+--   for details).
+defaultStrength :: Int
+defaultStrength = 17
+
+-- | The type representing account information stored in the database should
+--   be an instance of this class.  It just provides the getter and setter
+--   used by the functions in this module.
+class HasPasswordHash account where
+    getPasswordHash :: account -> Text
+    setPasswordHash :: Text -> account -> account
+
+    {-# MINIMAL getPasswordHash, setPasswordHash #-}
+
+
+-- | Calculate a new-style password hash using "Yesod.Auth.Util.PasswordStore".
+passwordHash :: MonadIO m => Int -> Text -> m Text
+passwordHash strength pwd = do
+    h <- liftIO $ makePassword (BS.pack $ unpack pwd) strength
+    return $ pack $ BS.unpack h
+
+-- | Set password for account, using the given strength setting. Use this
+--   function, or 'setPassword', to produce a account record containing the
+--   hashed password.  Unlike previous versions of this module, no separate
+--   salt field is required for new passwords (but it may still be required
+--   for compatibility while old password hashes remain in the database).
+--
+--   This function does not change the database; the calling application
+--   is responsible for saving the data which is returned.
+setPasswordStrength :: (MonadIO m, HasPasswordHash account) => Int -> Text -> account -> m account
+setPasswordStrength strength pwd u = do
+    hashed <- passwordHash strength pwd
+    return $ setPasswordHash hashed u
+
+-- | As 'setPasswordStrength', but using the 'defaultStrength'
+setPassword :: (MonadIO m, HasPasswordHash account) => Text -> account -> m account
+setPassword = setPasswordStrength defaultStrength
+
+validatePass :: HasPasswordHash u => u -> Text -> Bool
+validatePass account password = do
+    let h = getPasswordHash account
+    -- NB plaintext password characters are truncated to 8 bits here,
+    -- and also in passwordHash above (the hash is already 8 bit).
+    -- This is for historical compatibility, but in practice it is
+    -- unlikely to reduce the entropy of most users' alphabets by much.
+    let hash'     = BS.pack $ unpack h
+        password' = BS.pack $ unpack password
+    if passwordStrength hash' > 0
+        -- Will give >0 for valid hash format, else treat as if wrong password
+        then verifyPassword password' hash'
+        else False
+
+instance HasPasswordHash Account where
+    getPasswordHash = accountPassword
+    setPasswordHash h u = u { accountPassword = h }