haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Drop mwc-random

Browse Source
This commit is contained in:
Michael Snoyman 2018-01-15 10:18:16 +02:00
parent aa5b80d9f8
commit 1a1cb8a45f
No known key found for this signature in database
GPG Key ID: A048E8C057E86876
7 changed files with 39 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
yesod-core/Yesod/Core/Class/Yesod.hs
View File

@ -39,7 +39,6 @@ import Data.Word (Word64)
import Language.Haskell.TH.Syntax (Loc (..))
import Network.HTTP.Types (encodePath, renderQueryText)
import qualified Network.Wai as W
import Data.Default (def)
import Network.Wai.Parse (lbsBackEnd,
tempFileBackEnd)
import Network.Wai.Logger (ZonedDate, clockDateCacher)
@ -52,7 +51,7 @@ import Text.Hamlet
import Text.Julius
import qualified Web.ClientSession as CS
import Web.Cookie (SetCookie (..), parseCookies, sameSiteLax,
sameSiteStrict, SameSiteOption)
sameSiteStrict, SameSiteOption, defaultSetCookie)
import Yesod.Core.Types
import Yesod.Core.Internal.Session
import Yesod.Core.Widget
@ -865,7 +864,7 @@ loadClientSession key getCachedDate sessionName req = load
save date sess' = do
-- We should never cache the IV! Be careful!
iv <- liftIO CS.randomIV
return [AddCookie def
return [AddCookie defaultSetCookie
{ setCookieName = sessionName
, setCookieValue = encodeClientSession key iv date host sess'
, setCookiePath = Just "/"

11
yesod-core/Yesod/Core/Dispatch.hs
View File

@ -64,6 +64,7 @@ import Yesod.Core.Class.Dispatch
import Yesod.Core.Internal.Run
import Safe (readMay)
import System.Environment (getEnvironment)
import qualified System.Random as Random
import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction, updateFreq)
import Yesod.Core.Internal.Util (getCurrentMaxExpiresRFC1123)
@ -79,7 +80,6 @@ import Control.Monad.Logger
import Control.Monad (when)
import qualified Paths_yesod_core
import Data.Version (showVersion)
import qualified System.Random.MWC as MWC
-- | Convert the given argument into a WAI application, executable with any WAI
-- handler. This function will provide no middlewares; if you want commonly
@ -88,16 +88,18 @@ toWaiAppPlain :: YesodDispatch site => site -> IO W.Application
toWaiAppPlain site = do
logger <- makeLogger site
sb <- makeSessionBackend site
gen <- MWC.createSystemRandom
getMaxExpires <- getGetMaxExpires
return $ toWaiAppYre YesodRunnerEnv
{ yreLogger = logger
, yreSite = site
, yreSessionBackend = sb
, yreGen = gen
, yreGen = defaultGen
, yreGetMaxExpires = getMaxExpires
}
defaultGen :: IO Int
defaultGen = Random.getStdRandom Random.next
-- | Pure low level function to construct WAI application. Usefull
-- when you need not standard way to run your app, or want to embed it
-- inside another app.
@ -152,13 +154,12 @@ toWaiApp site = do
toWaiAppLogger :: YesodDispatch site => Logger -> site -> IO W.Application
toWaiAppLogger logger site = do
sb <- makeSessionBackend site
gen <- MWC.createSystemRandom
getMaxExpires <- getGetMaxExpires
let yre = YesodRunnerEnv
{ yreLogger = logger
, yreSite = site
, yreSessionBackend = sb
, yreGen = gen
, yreGen = defaultGen
, yreGetMaxExpires = getMaxExpires
}
messageLoggerSource

8
yesod-core/Yesod/Core/Handler.hs
View File

@ -228,7 +228,7 @@ import Data.Monoid (Endo (..))
import Data.Text (Text)
import qualified Network.Wai.Parse as NWP
import Text.Shakespeare.I18N (RenderMessage (..))
import Web.Cookie (SetCookie (..))
import Web.Cookie (SetCookie (..), defaultSetCookie)
import Yesod.Core.Content (ToTypedContent (..), simpleContentType, contentTypeTypes, HasContentType (..), ToContent (..), ToFlushBuilder (..))
import Yesod.Core.Internal.Util (formatRFC1123)
import Text.Blaze.Html (preEscapedToHtml, toHtml)
@ -250,7 +250,6 @@ import Data.Conduit (ConduitT, transPipe, Flush (Flush), yield, Void)
import qualified Yesod.Core.TypeCache as Cache
import qualified Data.Word8 as W8
import qualified Data.Foldable as Fold
import Data.Default
import Control.Monad.Logger (MonadLogger, logWarnS)
get :: MonadHandler m => m GHState
@ -1474,7 +1473,10 @@ defaultCsrfCookieName = "XSRF-TOKEN"
--
-- @since 1.4.14
setCsrfCookie :: MonadHandler m => m ()
setCsrfCookie = setCsrfCookieWithCookie def { setCookieName = defaultCsrfCookieName, setCookiePath = Just "/" }
setCsrfCookie = setCsrfCookieWithCookie defaultSetCookie
{ setCookieName = defaultCsrfCookieName
, setCookiePath = Just "/"
}
-- | Takes a 'SetCookie' and overrides its value with a CSRF token, then sets the cookie.
--

22
yesod-core/Yesod/Core/Internal/Request.hs
View File

@ -41,7 +41,6 @@ import Control.Monad ((<=<), liftM)
import Yesod.Core.Types
import qualified Data.Map as Map
import Data.IORef
import qualified System.Random.MWC as MWC
import Control.Monad.Primitive (PrimMonad, PrimState)
import qualified Data.Vector.Storable as V
import Data.ByteString.Internal (ByteString (PS))
@ -74,7 +73,7 @@ parseWaiRequest :: W.Request
-> SessionMap
-> Bool
-> Maybe Word64 -- ^ max body size
-> Either (IO YesodRequest) (MWC.GenIO -> IO YesodRequest)
-> Either (IO YesodRequest) (IO Int -> IO YesodRequest)
parseWaiRequest env session useToken mmaxBodySize =
-- In most cases, we won't need to generate any random values. Therefore,
-- we split our results: if we need a random generator, return a Right
@ -154,16 +153,21 @@ addTwoLetters (toAdd, exist) (l:ls) =
-- | Generate a random String of alphanumerical characters
-- (a-z, A-Z, and 0-9) of the given length using the given
-- random number generator.
randomString :: PrimMonad m => Int -> MWC.Gen (PrimState m) -> m Text
randomString :: Monad m => Int -> m Int -> m Text
randomString len gen =
liftM (decodeUtf8 . fromByteVector) $ V.replicateM len asciiChar
where
asciiChar = liftM toAscii $ MWC.uniformR (0, 61) gen
toAscii i
| i < 26 = i + Word8._A
| i < 52 = i + Word8._a - 26
| otherwise = i + Word8._0 - 52
asciiChar =
let loop = do
x <- gen
let y = fromIntegral $ x `mod` 64
case () of
()
| y < 26 -> return $ y + Word8._A
| y < 52 -> return $ y + Word8._a - 26
| y < 62 -> return $ y + Word8._0 - 52
| otherwise -> loop
in loop
fromByteVector :: V.Vector Word8 -> ByteString
fromByteVector v =

4
yesod-core/Yesod/Core/Types.hs
View File

@ -45,7 +45,6 @@ import Network.Wai (FilePart,
import qualified Network.Wai as W
import qualified Network.Wai.Parse as NWP
import System.Log.FastLogger (LogStr, LoggerSet, toLogStr, pushLogStr)
import qualified System.Random.MWC as MWC
import Network.Wai.Logger (DateCacheGetter)
import Text.Blaze.Html (Html, toHtml)
import Text.Hamlet (HtmlUrl)
@ -200,7 +199,8 @@ data YesodRunnerEnv site = YesodRunnerEnv
{ yreLogger :: !Logger
, yreSite :: !site
, yreSessionBackend :: !(Maybe SessionBackend)
, yreGen :: !MWC.GenIO
, yreGen :: !(IO Int)
-- ^ Generate a random number
, yreGetMaxExpires :: IO Text
}

22
yesod-core/test/YesodCoreTest/InternalRequest.hs
View File

@ -10,9 +10,11 @@ import Data.Map (singleton)
import Yesod.Core
import Data.Word (Word64)
import System.IO.Unsafe (unsafePerformIO)
import qualified System.Random.MWC as MWC
import Control.Monad.ST
import Control.Monad (replicateM)
import System.Random
gen :: IO Int
gen = getStdRandom next
randomStringSpecs :: Spec
randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do
@ -21,21 +23,19 @@ randomStringSpecs = describe "Yesod.Internal.Request.randomString" $ do
-- NOTE: this testcase may break on other systems/architectures if
-- mkStdGen is not identical everywhere (is it?).
_looksRandom :: Bool
_looksRandom = runST $ do
gen <- MWC.create
_looksRandom :: IO ()
_looksRandom = do
s <- randomString 20 gen
return $ s == "VH9SkhtptqPs6GqtofVg"
s `shouldBe` "VH9SkhtptqPs6GqtofVg"
noRepeat :: Int -> Int -> Bool
noRepeat len n = runST $ do
gen <- MWC.create
noRepeat :: Int -> Int -> IO ()
noRepeat len n = do
ss <- replicateM n $ randomString len gen
return $ length (nub ss) == n
length (nub ss) `shouldBe` n
-- For convenience instead of "(undefined :: StdGen)".
g :: MWC.GenIO
g :: IO Int
g = error "test/YesodCoreTest/InternalRequest.g"
parseWaiRequest' :: Request

5
yesod-core/yesod-core.cabal
View File

@ -52,16 +52,12 @@ library
, resourcet >= 1.2
, blaze-html >= 0.5
, blaze-markup >= 0.7.1
-- FIXME remove!
, data-default
, safe
, warp >= 3.0.2
, unix-compat
, conduit-extra
, deepseq >= 1.3
, deepseq-generics
-- FIXME remove
, mwc-random
, primitive
, word8
, auto-update
@ -199,7 +195,6 @@ test-suite tests
, shakespeare
, streaming-commons
, wai-extra
, mwc-random
, cookie >= 0.4.1 && < 0.5
, unliftio
ghc-options: -Wall