5090322 · denis · git.iko.soy

git.iko.soy/denis

on master help sign in

Started doing hashing

5090322iko7 years ago

denis/package.yaml+1−1

compare with master

unifiedsplit

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

63- mime-mail

64- periodic

65- ua-parser

66−

66+- cryptohash-sha512

69library:

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

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

95import Data.Char

96import qualified Data.Vector as V

97import Server.Auth.Token

98−import Data.Int

100-- MARK: Documentation

99-- MARK: Documentation

101

100

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

911-- NOTE: Not transactional

910-- NOTE: Not transactional

912validateToken :: Token -> StaticPQ ()

911validateToken :: Token -> StaticPQ ()

913validateToken token = do

912validateToken token = do

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

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

915 void $ manipulateParams validateUserQ $ Only $ tokenUserId token

914 void $ manipulateParams validateUserQ $ Only $ tokenUserId token

916

915

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

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

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

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

919

918

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

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

921tryVerifyToken uId tokenData code = commitedTransactionallyUpdate $ do

920tryVerifyToken uId tokenData code = commitedTransactionallyUpdate $ do

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

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

923 case token' of

922 case token' of

924 Nothing -> return Nothing

923 Nothing -> return Nothing

925 Just token -> do

924 Just token -> do

926− if (tokenVerificationCode token == Just code)

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

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

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

928 else do

927 else do

929 let triesLeft = tokenActivationTriesLeft token - 1

928 let triesLeft = tokenActivationTriesLeft token - 1

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

935 return Nothing

934 return Nothing

936

935

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

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

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

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

939

938

940-- MARK: Utils

939-- MARK: Utils

941

940

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

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

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

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

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

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

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

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

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

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

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

293 notNullable int8 `as` #tokenUserId :*

294 notNullable bytea `as` #tokenValue :*

295 notNullable timestampWithTimeZone `as` #tokenExpiryDate :*

296− nullable int4 `as` #tokenVerificationCode :*

296+ nullable bytea `as` #tokenVerificationCode :*

297 notNullable int4 `as` #tokenActivationTriesLeft :*

298 notNullable text `as` #tokenUserAgent :*

299 nullable bytea `as` #tokenActivationCode :*

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

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

51import Data.Maybe

52import Server.Auth.Token

53import Server.Auth.Mail

54−import Data.Int

55import Web.UAParser

54import Web.UAParser

56import qualified Data.Text.Lazy as TL

55import qualified Data.Text.Lazy as TL

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

63instance ToSample UserLoginResponse where

62instance ToSample UserLoginResponse where

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

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

66−instance ToSample Int32 where

65+instance ToSample Int where

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

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

69instance ToSample UserCreation where

68instance ToSample UserCreation where

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

90 :> Header "cookie" String

89 :> Header "cookie" String

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

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

92 "verify" :> VerifyDescription :>

91 "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 :<|>

94 "register" :> RegisterDescription :>

93 "register" :> RegisterDescription :>

95 ReqBody '[JSON] UserCreation :>

94 ReqBody '[JSON] UserCreation :>

96 Header "User-Agent" String :>

95 Header "User-Agent" String :>

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

141 Nothing -> return . noHeader $ UserLoginResponse UserCanRegister

140 Nothing -> return . noHeader $ UserLoginResponse UserCanRegister

142 Just User{..} -> do

141 Just User{..} -> do

143 let ua = getUserAgent ua'

142 let ua = getUserAgent ua'

144− token <- generateToken userId ua

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

145 runQerror . createToken $ token

144 runQerror . createToken $ token

146− let cookie = generateCookie token

145+ let cookie = generateCookie token value

147− case tokenVerificationCode token of

148− Just code -> do

149− sendTokenVerificationEmail code (TL.fromStrict ua) email

146+ sendTokenVerificationEmail code (TL.fromStrict ua) email

150− return . addHeader cookie $ UserLoginResponse UserIsRegistered

147+ return . addHeader cookie $ UserLoginResponse UserIsRegistered

151− Nothing -> throwError err500

148+

152−

153−generateCookie :: Token -> String

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

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

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

155 setCookieName = cookieTokenKey,

151 setCookieName = cookieTokenKey,

156− setCookieValue = L.toStrict . encode $ AuthenticationCookieData

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

157− (tokenUserId token)

158− (tokenValue token),

159 setCookieExpires = Just (tokenExpiryDate token),

153 setCookieExpires = Just (tokenExpiryDate token),

160 setCookiePath = Just "/",

154 setCookiePath = Just "/",

161 setCookieHttpOnly = True,

155 setCookieHttpOnly = True,

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

171 Nothing -> throwError err401

165 Nothing -> throwError err401

172 Just _ -> return NoContent

166 Just _ -> return NoContent

173

167

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

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

175verifyToken Nothing _ = throwError err400

169verifyToken Nothing _ = throwError err400

176verifyToken (Just cookie) code = do

170verifyToken (Just cookie) code = do

177 let mbToken = getCookie cookie

171 let mbToken = getCookie cookie

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

208 unless (validateUser creation) $ throwError err400

202 unless (validateUser creation) $ throwError err400

209 genToken <- generateTokenM

203 genToken <- generateTokenM

210 let ua = getUserAgent ua'

204 let ua = getUserAgent ua'

211− token <- runQ err409 . commitedTransactionallyUpdate $ do

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

212 uId <- createUser creation

206 uId <- createUser creation

213− let token = genToken uId ua

207+ let gToken = genToken uId ua

214− createToken token

208+ createToken . generatedToken $ gToken

215− return token

209+ return gToken

216− case tokenVerificationCode token of

217− Just code -> do

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

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

219− let cookie = generateCookie token

211+ let cookie = generateCookie token value

220− return $ addHeader cookie NoContent

212+ return $ addHeader cookie NoContent

221− Nothing -> throwError err500

222

213

223getUserAgent :: Maybe String -> T.Text

214getUserAgent :: Maybe String -> T.Text

224getUserAgent uaData' = fromMaybe "Unknown" $ do

215getUserAgent uaData' = fromMaybe "Unknown" $ do

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

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

13 Token(..),

14 generateToken,

15 TokenVerificationCode,

16− generateTokenM

16+ generateTokenM,

17+ hashVerificationCode,

18+ GeneratedToken(..),

19+ hash

17 ) where

20 ) where

19import Data.Time.Clock

22import Data.Time.Clock

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

25import Control.Monad.IO.Class

28import Control.Monad.IO.Class

26import Crypto.RNG

29import Crypto.RNG

27import Data.Text (Text)

30import Data.Text (Text)

31+import Crypto.Hash.SHA512

32+import qualified Data.ByteString.Char8 as C

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+}

31data Token = Token {

44data Token = Token {

32 tokenUserId :: UserId,

45 tokenUserId :: UserId,

33 tokenValue :: ByteString,

46 tokenValue :: ByteString,

34 tokenExpiryDate :: UTCTime,

47 tokenExpiryDate :: UTCTime,

35− tokenVerificationCode :: Maybe TokenVerificationCode,

48+ tokenVerificationCode :: Maybe ByteString,

36 tokenActivationTriesLeft :: Int32,

49 tokenActivationTriesLeft :: Int32,

37 tokenUserAgent :: Text,

50 tokenUserAgent :: Text,

38 tokenActivationCode :: Maybe ByteString,

51 tokenActivationCode :: Maybe ByteString,

39 tokenDeactivationCode :: ByteString

52 tokenDeactivationCode :: ByteString

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

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

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

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

43generateToken uId ua = do

56generateToken uId ua = do

44 gen <- generateTokenM

57 gen <- generateTokenM

45 return $ gen uId ua

58 return $ gen uId ua

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

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

48generateTokenM = do

61generateTokenM = do

49 token <- randomBytes 64

62 token <- randomBytes 64

50 activationToken <- randomBytes 64

63 activationToken <- randomBytes 64

51 deactivationToken <- randomBytes 64

64 deactivationToken <- randomBytes 64

52 code <- randomR (0, 999999)

65 code <- randomR (0, 999999)

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

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

67+ return $ \ uId ua -> GeneratedToken {

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

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