playing around with hashes and randomness

This commit is contained in:
nek0 2022-04-16 16:09:50 +02:00
parent dfd1b0e1f7
commit 109b6867f4
5 changed files with 31 additions and 11 deletions

View file

@ -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

View file

@ -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
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 aspayload conn
putUserAuthInfo uid asmethod ascomment hashstring conn
CryptoFailed err -> do
throwError $ err500
{ errBody = "Crypto Error: " <> fromString (show err)
}
else
throwError $ err401
{ errBody = "Unauthorized access"

View file

@ -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)

View file

@ -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

View file

@ -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)