5090322 · denis · git.iko.soy

git.iko.soy/denis

Started doing hashing

commit509032290aaada370abd675fcf65598c536d3a0b authoriko <ilyakooo0@gmail.com> dateSat 11 May 2019, 14:28 (7 years ago) parent03720f4

5 files changed+54−42

compare with master

unifiedsplit

denis/package.yaml+1−1 denis/src/Data/Query.hs+5−6 denis/src/Data/Schema.hs+2−2 denis/src/Server/Auth.hs+18−27 denis/src/Server/Auth/Token.hs+28−6

denis/package.yaml+1−1

@@ -63,7 +63,7 @@ dependencies:

6363- mime-mail

6464- periodic

6565- ua-parser

66−

66+- cryptohash-sha512

6767

6868

6969library:

denis/src/Data/Query.hs+5−6

@@ -95,7 +95,6 @@ import Data.Foldable (fold)

9595import Data.Char

9696import qualified Data.Vector as V

9797import Server.Auth.Token

98−import Data.Int

9998

10099-- MARK: Documentation

101100

@@ -911,19 +910,19 @@ createToken token = void $ manipulateParams createTokenQ token

911910-- NOTE: Not transactional

912911validateToken :: Token -> StaticPQ ()

913912validateToken token = do

914− void $ manipulateParams updateTokenQ token{tokenVerificationCode = Nothing}

913+ void $ manipulateParams updateTokenQ token{tokenVerificationCode = Nothing, tokenActivationCode = Nothing}

915914 void $ manipulateParams validateUserQ $ Only $ tokenUserId token

916915

917916invalidateToken :: UserId -> ByteString -> StaticPQ ()

918917invalidateToken uId bs = void . manipulateParams deleteTokenQ $ (uId, bs)

919918

920−tryVerifyToken :: UserId -> ByteString -> Int32 -> StaticPQ (Maybe Token)

919+tryVerifyToken :: UserId -> ByteString -> Int -> StaticPQ (Maybe Token)

921920tryVerifyToken uId tokenData code = commitedTransactionallyUpdate $ do

922− token' <- runQueryParams getTokenQ (uId, tokenData) >>= firstRow

921+ token' <- runQueryParams getTokenQ (uId, hash tokenData) >>= firstRow

923922 case token' of

924923 Nothing -> return Nothing

925924 Just token -> do

926− if (tokenVerificationCode token == Just code)

925+ if (tokenVerificationCode token == Just (hashVerificationCode code))

927926 then validateToken token >> (return $ Just token)

928927 else do

929928 let triesLeft = tokenActivationTriesLeft token - 1

@@ -935,7 +934,7 @@ tryVerifyToken uId tokenData code = commitedTransactionallyUpdate $ do

935934 return Nothing

936935

937936getVerifiedToken :: UserId -> ByteString -> StaticPQ (Maybe Token)

938−getVerifiedToken uId tokenData = runQueryParams getVerifiedTokenQ (uId, tokenData) >>= firstRow

937+getVerifiedToken uId tokenData = runQueryParams getVerifiedTokenQ (uId, hash tokenData) >>= firstRow

939938

940939-- MARK: Utils

941940

denis/src/Data/Schema.hs+2−2

@@ -166,7 +166,7 @@ type Schema =

166166 "tokenUserId" ::: 'NoDef :=> 'NotNull 'PGint8,

167167 "tokenValue" ::: 'NoDef :=> 'NotNull 'PGbytea,

168168 "tokenExpiryDate" ::: 'NoDef :=> 'NotNull 'PGtimestamptz,

169− "tokenVerificationCode" ::: 'NoDef :=> 'Null 'PGint4, -- null == verified

169+ "tokenVerificationCode" ::: 'NoDef :=> 'Null 'PGbytea, -- null == verified

170170 "tokenActivationTriesLeft" ::: 'NoDef :=> 'NotNull 'PGint4,

171171 "tokenUserAgent" ::: 'NoDef :=> 'NotNull 'PGtext,

172172 "tokenActivationCode" ::: 'NoDef :=> 'Null 'PGbytea,

@@ -293,7 +293,7 @@ createTables = createTable #faculties (

293293 notNullable int8 `as` #tokenUserId :*

294294 notNullable bytea `as` #tokenValue :*

295295 notNullable timestampWithTimeZone `as` #tokenExpiryDate :*

296− nullable int4 `as` #tokenVerificationCode :*

296+ nullable bytea `as` #tokenVerificationCode :*

297297 notNullable int4 `as` #tokenActivationTriesLeft :*

298298 notNullable text `as` #tokenUserAgent :*

299299 nullable bytea `as` #tokenActivationCode :*

denis/src/Server/Auth.hs+18−27

@@ -51,7 +51,6 @@ import qualified Data.ByteString.Base64 as BS

5151import Data.Maybe

5252import Server.Auth.Token

5353import Server.Auth.Mail

54−import Data.Int

5554import Web.UAParser

5655import qualified Data.Text.Lazy as TL

5756

@@ -63,7 +62,7 @@ instance ToSample AuthenticationCredits where

6362instance ToSample UserLoginResponse where

6463 toSamples _ = samples $ map UserLoginResponse [UserIsRegistered, UserCanRegister, InvalidUser]

6564

66−instance ToSample Int32 where

65+instance ToSample Int where

6766 toSamples _ = samples [382934, 103845, 294905]

6867

6968instance ToSample UserCreation where

@@ -90,7 +89,7 @@ type AuthenticationHandler =

9089 :> Header "cookie" String

9190 :> PostNoContent '[JSON, PlainText, FormUrlEncoded] (Headers '[Header "Set-Cookie" String] NoContent) :<|>

9291 "verify" :> VerifyDescription :>

93− Header "cookie" String :> ReqBody '[JSON] Int32 :> PostNoContent '[JSON, PlainText, FormUrlEncoded] NoContent :<|>

92+ Header "cookie" String :> ReqBody '[JSON] Int :> PostNoContent '[JSON, PlainText, FormUrlEncoded] NoContent :<|>

9493 "register" :> RegisterDescription :>

9594 ReqBody '[JSON] UserCreation :>

9695 Header "User-Agent" String :>

@@ -141,21 +140,16 @@ logIn (AuthenticationCredits email') ua' = do

141140 Nothing -> return . noHeader $ UserLoginResponse UserCanRegister

142141 Just User{..} -> do

143142 let ua = getUserAgent ua'

144− token <- generateToken userId ua

143+ GeneratedToken token value code activation deactivation <- generateToken userId ua

145144 runQerror . createToken $ token

146− let cookie = generateCookie token

147− case tokenVerificationCode token of

148− Just code -> do

149− sendTokenVerificationEmail code (TL.fromStrict ua) email

150− return . addHeader cookie $ UserLoginResponse UserIsRegistered

151− Nothing -> throwError err500

152−

153−generateCookie :: Token -> String

154−generateCookie token = L.unpack . toLazyByteString . renderSetCookie $ defaultSetCookie {

145+ let cookie = generateCookie token value

146+ sendTokenVerificationEmail code (TL.fromStrict ua) email

147+ return . addHeader cookie $ UserLoginResponse UserIsRegistered

148+

149+generateCookie :: Token -> BS.ByteString -> String

150+generateCookie token value = L.unpack . toLazyByteString . renderSetCookie $ defaultSetCookie {

155151 setCookieName = cookieTokenKey,

156− setCookieValue = L.toStrict . encode $ AuthenticationCookieData

157− (tokenUserId token)

158− (tokenValue token),

152+ setCookieValue = L.toStrict . encode $ AuthenticationCookieData (tokenUserId token) value,

159153 setCookieExpires = Just (tokenExpiryDate token),

160154 setCookiePath = Just "/",

161155 setCookieHttpOnly = True,

@@ -171,7 +165,7 @@ checkCookie cookie = do

171165 Nothing -> throwError err401

172166 Just _ -> return NoContent

173167

174−verifyToken :: Maybe String -> Int32 -> App NoContent

168+verifyToken :: Maybe String -> Int -> App NoContent

175169verifyToken Nothing _ = throwError err400

176170verifyToken (Just cookie) code = do

177171 let mbToken = getCookie cookie

@@ -208,17 +202,14 @@ register creation' ua' = do

208202 unless (validateUser creation) $ throwError err400

209203 genToken <- generateTokenM

210204 let ua = getUserAgent ua'

211− token <- runQ err409 . commitedTransactionallyUpdate $ do

205+ GeneratedToken token value code activation deactivation <- runQ err409 . commitedTransactionallyUpdate $ do

212206 uId <- createUser creation

213− let token = genToken uId ua

214− createToken token

215− return token

216− case tokenVerificationCode token of

217− Just code -> do

218− sendTokenVerificationEmail code (TL.fromStrict ua) (userCreationUserEmail creation)

219− let cookie = generateCookie token

220− return $ addHeader cookie NoContent

221− Nothing -> throwError err500

207+ let gToken = genToken uId ua

208+ createToken . generatedToken $ gToken

209+ return gToken

210+ sendTokenVerificationEmail code (TL.fromStrict ua) (userCreationUserEmail creation)

211+ let cookie = generateCookie token value

212+ return $ addHeader cookie NoContent

222213

223214getUserAgent :: Maybe String -> T.Text

224215getUserAgent uaData' = fromMaybe "Unknown" $ do

denis/src/Server/Auth/Token.hs+28−6

@@ -13,7 +13,10 @@ module Server.Auth.Token (

1313 Token(..),

1414 generateToken,

1515 TokenVerificationCode,

16− generateTokenM

16+ generateTokenM,

17+ hashVerificationCode,

18+ GeneratedToken(..),

19+ hash

1720 ) where

1821

1922import Data.Time.Clock

@@ -25,30 +28,49 @@ import Data.Int

2528import Control.Monad.IO.Class

2629import Crypto.RNG

2730import Data.Text (Text)

31+import Crypto.Hash.SHA512

32+import qualified Data.ByteString.Char8 as C

2833

29−type TokenVerificationCode = Int32

34+type TokenVerificationCode = Int

35+

36+data GeneratedToken = GeneratedToken {

37+ generatedToken :: Token,

38+ generatedTokenValue :: ByteString,

39+ generatedVerificationCode :: Int,

40+ generatedActivationCode :: ByteString,

41+ generatedDeactivationCode :: ByteString

42+}

3043

3144data Token = Token {

3245 tokenUserId :: UserId,

3346 tokenValue :: ByteString,

3447 tokenExpiryDate :: UTCTime,

35− tokenVerificationCode :: Maybe TokenVerificationCode,

48+ tokenVerificationCode :: Maybe ByteString,

3649 tokenActivationTriesLeft :: Int32,

3750 tokenUserAgent :: Text,

3851 tokenActivationCode :: Maybe ByteString,

3952 tokenDeactivationCode :: ByteString

4053} deriving (Show, GHC.Generic, SOP.Generic, SOP.HasDatatypeInfo)

4154

42−generateToken :: (MonadIO m, CryptoRNG m) => UserId -> Text -> m Token

55+generateToken :: (MonadIO m, CryptoRNG m) => UserId -> Text -> m GeneratedToken

4356generateToken uId ua = do

4457 gen <- generateTokenM

4558 return $ gen uId ua

4659

47−generateTokenM :: (MonadIO m, CryptoRNG m) => m (UserId -> Text -> Token)

60+generateTokenM :: (MonadIO m, CryptoRNG m) => m (UserId -> Text -> GeneratedToken)

4861generateTokenM = do

4962 token <- randomBytes 64

5063 activationToken <- randomBytes 64

5164 deactivationToken <- randomBytes 64

5265 code <- randomR (0, 999999)

5366 expire <- liftIO $ fmap (addUTCTime (nominalDay * 365)) getCurrentTime -- one year

54− return $ \ uId ua -> Token uId token expire (Just code) 10 ua (Just activationToken) deactivationToken

67+ return $ \ uId ua -> GeneratedToken {

68+ generatedToken = Token uId (hash token) expire (Just . hashVerificationCode $ code) 10 ua (Just . hash $ activationToken) (hash deactivationToken),

69+ generatedTokenValue = token,

70+ generatedVerificationCode = code,

71+ generatedActivationCode = activationToken,

72+ generatedDeactivationCode = deactivationToken

73+ }

74+

75+hashVerificationCode :: Int -> ByteString

76+hashVerificationCode = hash . C.pack . show