From 7b6ea276b40b841909b01ea1f53c40779f86eee5 Mon Sep 17 00:00:00 2001 From: nek0 Date: Sat, 16 Apr 2022 16:40:10 +0200 Subject: [PATCH] more playing --- src/Control/Auth.hs | 2 +- src/Model/Auth.hs | 30 +++++++++++++----------------- src/Util.hs | 3 --- src/Util/Random.hs | 8 ++++++++ 4 files changed, 22 insertions(+), 21 deletions(-) create mode 100644 src/Util/Random.hs diff --git a/src/Control/Auth.hs b/src/Control/Auth.hs index 3bea655..8341dc9 100644 --- a/src/Control/Auth.hs +++ b/src/Control/Auth.hs @@ -21,7 +21,7 @@ import Data.Text.Encoding import Types import Model -import Util +import Util.Random authGet :: TicketRequest diff --git a/src/Model/Auth.hs b/src/Model/Auth.hs index 2c8e801..ca30a4c 100644 --- a/src/Model/Auth.hs +++ b/src/Model/Auth.hs @@ -38,7 +38,7 @@ import Opaleye hiding (null) import Types.Auth import Types.Reader import Classes - +import Util.Random initToken :: PGS.Query initToken = mconcat @@ -51,12 +51,12 @@ initToken = mconcat ] tokenTable :: Table - ( Field SqlText + ( Field SqlBytea , Field SqlInt4 , Field SqlTimestamptz , Field SqlInt4 ) - ( Field SqlText + ( Field SqlBytea , Field SqlInt4 , Field SqlTimestamptz , Field SqlInt4 @@ -110,10 +110,6 @@ delayTime :: Int delayTime = 1 * 10 ^ (6 :: Int) -generateRandomText :: IO T.Text -generateRandomText = decodeUtf8 . B64.encode <$> random 23 - - selectAuthOverviews :: Int -- ^ User ID -> PGS.Connection -- ^ Connection Handler @@ -160,9 +156,9 @@ getUserAuthInfo uid method conn = do then -- generate mock AuthInfo liftIO $ do - rand1 <- generateRandomText + rand1 <- decodeUtf8 <$> randomString rand2 <- case method of - ChallengeResponse -> Just <$> generateRandomText + ChallengeResponse -> Just . decodeUtf8 <$> randomString _ -> return Nothing return $ AuthInfo rand2 (AuthTicket rand1) else @@ -212,7 +208,7 @@ validateToken header conn = do tokens <- liftIO $ map fromDatabase <$> runSelect conn ( proc () -> do stuff@(tstr, _, _, _) <- (selectTable tokenTable) -< () - restrict -< toFields (decodeUtf8 header) .== tstr + restrict -< toFields header .== tstr returnA -< stuff ) case tokens of @@ -221,7 +217,7 @@ validateToken header conn = do if diffUTCTime stamp now_ > 0 then return $ Just (uid, method) else do - void $ deleteToken (decodeUtf8 header) conn + void $ deleteToken header conn liftIO $ threadDelay delayTime throwError $ err401 { errBody = "Your token expired!" @@ -256,7 +252,7 @@ generateToken (Ticket _ tuid _ (method, _)) (AuthResponse response) conn = do if authResult then do token <- liftIO $ Token - <$> generateRandomText + <$> (decodeUtf8 <$> randomString) <*> pure tuid <*> (addUTCTime (23*60) <$> getCurrentTime) <*> pure method @@ -274,13 +270,13 @@ generateToken (Ticket _ tuid _ (method, _)) (AuthResponse response) conn = do insertToken :: Token -> PGS.Connection - -> MateHandler T.Text + -> MateHandler ByteString insertToken (Token tString tUser tExpiry tMethod) conn = fmap head $ liftIO $ runInsert_ conn $ Insert { iTable = tokenTable , iRows = [ - ( toFields tString + ( toFields (encodeUtf8 tString) , toFields tUser , toFields tExpiry , toFields (fromEnum tMethod) @@ -292,7 +288,7 @@ insertToken (Token tString tUser tExpiry tMethod) conn = deleteToken - :: T.Text + :: ByteString -> PGS.Connection -> Handler Int64 deleteToken tstr conn = @@ -328,9 +324,9 @@ deleteOldTokens now_ conn = runDelete_ conn $ Delete newTicket :: Int -> AuthMethod -> MateHandler (Maybe T.Text, AuthTicket) newTicket ident method = do store <- asks rsTicketStore - rand1 <- liftIO generateRandomText + rand1 <- liftIO (decodeUtf8 <$> randomString) rand2 <- liftIO $ case method of - ChallengeResponse -> Just <$> generateRandomText + ChallengeResponse -> Just . decodeUtf8 <$> randomString _ -> return Nothing later <- liftIO (addUTCTime 23 <$> getCurrentTime) let ticket = Ticket diff --git a/src/Util.hs b/src/Util.hs index 2aed3ea..4d02b72 100644 --- a/src/Util.hs +++ b/src/Util.hs @@ -155,6 +155,3 @@ sendNotification mail = do else print ("Warning: sending notification failed: Sendmail not present!" :: String) - -randomString :: IO BS.ByteString -randomString = uniformByteStringM 32 =<< newIOGenM (mkStdGen 23) diff --git a/src/Util/Random.hs b/src/Util/Random.hs new file mode 100644 index 0000000..daf63e7 --- /dev/null +++ b/src/Util/Random.hs @@ -0,0 +1,8 @@ +module Util.Random where + +import qualified Data.ByteString as BS + +import System.Random.Stateful (uniformByteStringM, newIOGenM, mkStdGen) + +randomString :: IO BS.ByteString +randomString = uniformByteStringM 32 =<< newIOGenM (mkStdGen 23)