diff --git a/mateamt.cabal b/mateamt.cabal index cf49701..3c395de 100644 --- a/mateamt.cabal +++ b/mateamt.cabal @@ -83,7 +83,7 @@ library , bytestring >=0.10.12.0 , base16-bytestring , base64-bytestring - , random-bytestring + , random , servant , servant-server , servant-rawm >= 0.3.0.0 diff --git a/src/Control/Auth.hs b/src/Control/Auth.hs index 32978e5..3bea655 100644 --- a/src/Control/Auth.hs +++ b/src/Control/Auth.hs @@ -10,10 +10,18 @@ import Control.Monad.IO.Class (liftIO) import Control.Concurrent.STM (readTVarIO) +import Crypto.KDF.Argon2 +import Crypto.Error + +import Data.String (fromString) + +import Data.Text.Encoding + -- internal imports import Types import Model +import Util authGet :: TicketRequest @@ -61,10 +69,18 @@ authManageNewAuth -> AuthSubmit -> MateHandler Int authManageNewAuth (Just (uid, method)) (AuthSubmit asmethod ascomment aspayload) = - if method `elem` [PrimaryPass, ChallengeResponse] + if method == PrimaryPass then do - conn <- asks rsConnection - putUserAuthInfo uid asmethod ascomment aspayload conn + salt <- liftIO randomString + let mhashstring = decodeUtf8 <$> hash defaultOptions (encodeUtf8 aspayload) salt 64 + case mhashstring of + CryptoPassed hashstring -> do + conn <- asks rsConnection + putUserAuthInfo uid asmethod ascomment hashstring conn + CryptoFailed err -> do + throwError $ err500 + { errBody = "Crypto Error: " <> fromString (show err) + } else throwError $ err401 { errBody = "Unauthorized access" diff --git a/src/Model/Auth.hs b/src/Model/Auth.hs index 7134c43..2c8e801 100644 --- a/src/Model/Auth.hs +++ b/src/Model/Auth.hs @@ -29,7 +29,6 @@ import qualified Data.Set as S import Data.Time.Clock import Data.ByteString as B (ByteString) -import Data.ByteString.Random import qualified Data.ByteString.Base64 as B64 import Opaleye hiding (null) diff --git a/src/Types/Auth.hs b/src/Types/Auth.hs index aebb5c1..5dbd760 100644 --- a/src/Types/Auth.hs +++ b/src/Types/Auth.hs @@ -12,7 +12,6 @@ import qualified Data.Set as S import Data.Time.Clock (UTCTime) import Data.ByteString (ByteString) -import qualified Data.ByteString.Base64 as B64 import qualified Data.Text as T import Data.Text.Encoding @@ -55,10 +54,10 @@ instance FromJSON AuthInfo instance FromDatabase AuthInfo where - type OutTuple AuthInfo = (Maybe T.Text, T.Text) + type OutTuple AuthInfo = (Maybe ByteString, ByteString) fromDatabase (mChallenge, ticket) = - AuthInfo mChallenge (AuthTicket ticket) + AuthInfo (decodeUtf8 <$> mChallenge) (AuthTicket $ decodeUtf8 ticket) data AuthMethod @@ -152,10 +151,10 @@ data Token = Token instance FromDatabase Token where - type OutTuple Token = (T.Text, Int, UTCTime, Int) + type OutTuple Token = (ByteString, Int, UTCTime, Int) fromDatabase (string, usr, expiry, method) = - Token string usr expiry (toEnum method) + Token (decodeUtf8 string) usr expiry (toEnum method) type TicketStore = TVar (S.Set Ticket) @@ -194,7 +193,7 @@ instance FromDatabase AuthData where type OutTuple AuthData = (Int, Int, Int, T.Text, ByteString) fromDatabase (id_, usr, method, comm, payload) = - AuthData id_ usr (toEnum method) comm (decodeUtf8 $ B64.encode payload) + AuthData id_ usr (toEnum method) comm (decodeUtf8 payload) data AuthOverview = AuthOverview diff --git a/src/Util.hs b/src/Util.hs index 8f00829..2aed3ea 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -7,6 +7,7 @@ import Servant import Opaleye +import qualified Data.ByteString as BS import Data.ByteString.Lazy (fromStrict) import Data.Maybe (fromMaybe, fromJust) @@ -29,6 +30,8 @@ import Network.Mail.Mime import System.Directory (doesFileExist) +import System.Random.Stateful + -- internal imports import Model @@ -152,3 +155,6 @@ sendNotification mail = do else print ("Warning: sending notification failed: Sendmail not present!" :: String) + +randomString :: IO BS.ByteString +randomString = uniformByteStringM 32 =<< newIOGenM (mkStdGen 23)