Merge branch 'master' of https://github.com/yesodweb/yesod into dev.jp

This commit is contained in:
James Parker 2017-06-01 11:24:54 -04:00
commit 70f643b7e9
25 changed files with 175 additions and 40 deletions

View File

@ -53,9 +53,9 @@ matrix:
- env: BUILD=cabal GHCVER=7.10.3 CABALVER=1.22 HAPPYVER=1.19.5 ALEXVER=3.1.7
compiler: ": #GHC 7.10.3"
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
- env: BUILD=cabal GHCVER=8.0.1 CABALVER=head HAPPYVER=1.19.5 ALEXVER=3.1.7
compiler: ": #GHC 8.0.1"
addons: {apt: {packages: [cabal-install-head,ghc-8.0.1,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
- env: BUILD=cabal GHCVER=8.0.2 CABALVER=1.24 HAPPYVER=1.19.5 ALEXVER=3.1.7
compiler: ": #GHC 8.0.2"
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,happy-1.19.5,alex-3.1.7], sources: [hvr-ghc]}}
# Build with the newest GHC and cabal-install. This is an accepted failure,
# see below.

View File

@ -23,6 +23,20 @@ extra-deps:
- persistent-2.5
- persistent-sqlite-2.5
- cookie-0.4.2
- cryptonite-0.23
- foundation-0.0.9
- memory-0.14.5
- hfsevents-0.1.6
- x509-1.6.5
- x509-store-1.6.2
- x509-system-1.6.4
- x509-validation-1.6.5
- tls-1.3.8
- Win32-notify-0.3.0.1
- asn1-parse-0.9.4
- asn1-types-0.3.2
- connection-0.2.8
- socks-0.5.5
- conduit-extra-1.1.14
- streaming-commons-0.1.16

View File

@ -1,3 +1,11 @@
## 1.4.17.2
* Move to cryptonite from cryptohash
## 1.4.17.1
* Some translation fixes
## 1.4.17
* Add Show instance for user credentials `Creds`

View File

@ -117,9 +117,8 @@ import qualified Yesod.Auth.Message as Msg
import Yesod.Core
import Yesod.Form
import qualified Yesod.PasswordStore as PS
import Control.Applicative ((<$>), (<*>))
import qualified Crypto.Hash.MD5 as H
import qualified Crypto.Hash as H
import qualified Crypto.Nonce as Nonce
import Data.ByteString.Base16 as B16
import Data.Text (Text)
@ -134,6 +133,7 @@ import System.IO.Unsafe (unsafePerformIO)
import qualified Text.Email.Validate
import Data.Aeson.Types (Parser, Result(..), parseMaybe, withObject, (.:?))
import Data.Maybe (isJust, isNothing, fromJust)
import Data.ByteArray (convert)
loginR, registerR, forgotPasswordR, setpassR :: AuthRoute
loginR = PluginR "email" ["login"]
@ -811,7 +811,7 @@ saltPass = fmap (decodeUtf8With lenientDecode)
saltPass' :: String -> String -> String
saltPass' salt pass =
salt ++ T.unpack (TE.decodeUtf8 $ B16.encode $ H.hash $ TE.encodeUtf8 $ T.pack $ salt ++ pass)
salt ++ T.unpack (TE.decodeUtf8 $ B16.encode $ convert (H.hash (TE.encodeUtf8 $ T.pack $ salt ++ pass) :: H.Digest H.MD5))
isValidPass :: Text -- ^ cleartext password
-> SaltedPass -- ^ salted password

View File

@ -416,7 +416,7 @@ japaneseMessage LoginYahoo = "Yahooでログイン"
japaneseMessage Email = "Eメール"
japaneseMessage UserName = "ユーザー名" -- FIXME by Google Translate "user name"
japaneseMessage Password = "パスワード"
japaneseMessage CurrentPassword = "Current password"
japaneseMessage CurrentPassword = "現在のパスワード"
japaneseMessage Register = "登録"
japaneseMessage RegisterLong = "新規アカウント登録"
japaneseMessage EnterEmail = "メールアドレスを入力してください。確認メールが送られます"
@ -511,9 +511,9 @@ chineseMessage LoginOpenID = "用OpenID登录"
chineseMessage LoginGoogle = "用Google帐户登录"
chineseMessage LoginYahoo = "用Yahoo帐户登录"
chineseMessage Email = "邮箱"
chineseMessage UserName = "用户名" -- FIXME by Google Translate "user name"
chineseMessage UserName = "用户名"
chineseMessage Password = "密码"
chineseMessage CurrentPassword = "Current password"
chineseMessage CurrentPassword = "当前密码"
chineseMessage Register = "注册"
chineseMessage RegisterLong = "注册新帐户"
chineseMessage EnterEmail = "输入你的邮箱地址,你将收到一封确认邮件。"
@ -547,11 +547,10 @@ chineseMessage ProvideIdentifier = "邮箱或用户名"
chineseMessage SendPasswordResetEmail = "发送密码重置邮件"
chineseMessage PasswordResetPrompt = "输入你的邮箱地址或用户名,你将收到一封密码重置邮件。"
chineseMessage InvalidUsernamePass = "无效的用户名/密码组合"
-- TODO
chineseMessage i@(IdentifierNotFound _) = englishMessage i
chineseMessage Logout = "註銷" -- FIXME by Google Translate
chineseMessage LogoutTitle = "註銷" -- FIXME by Google Translate
chineseMessage AuthError = "验证错误" -- FIXME by Google Translate
chineseMessage (IdentifierNotFound ident) = "邮箱/用户名不存在: " `mappend` ident
chineseMessage Logout = "注销"
chineseMessage LogoutTitle = "注销"
chineseMessage AuthError = "验证错误"
czechMessage :: AuthMessage -> Text
czechMessage NoOpenID = "Nebyl nalezen identifikátor OpenID"

View File

@ -102,16 +102,14 @@ module Yesod.PasswordStore (
importSalt -- :: ByteString -> Salt
) where
import qualified Crypto.MAC.HMAC as CH
import qualified Crypto.Hash as CH
import qualified Crypto.Hash.SHA256 as H
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.Binary as Binary
import Control.Monad
import Control.Monad.ST
import Data.Byteable (toBytes)
import Data.STRef
import Data.Bits
import Data.ByteString.Char8 (ByteString)
@ -120,6 +118,7 @@ import System.IO
import System.Random
import Data.Maybe
import qualified Control.Exception
import Data.ByteArray (convert)
---------------------
-- Cryptographic base
@ -134,14 +133,18 @@ import qualified Control.Exception
-- matches.
pbkdf1 :: ByteString -> Salt -> Int -> ByteString
pbkdf1 password (SaltBS salt) iter = hashRounds first_hash (iter + 1)
where first_hash = H.finalize $ H.init `H.update` password `H.update` salt
where
first_hash =
convert $
((CH.hashFinalize $ CH.hashInit `CH.hashUpdate` password `CH.hashUpdate` salt) :: CH.Digest CH.SHA256)
-- | Hash a 'ByteString' for a given number of rounds. The number of rounds is 0
-- or more. If the number of rounds specified is 0, the ByteString will be
-- returned unmodified.
hashRounds :: ByteString -> Int -> ByteString
hashRounds (!bs) 0 = bs
hashRounds bs rounds = hashRounds (H.hash bs) (rounds - 1)
hashRounds bs rounds = hashRounds (convert (CH.hash bs :: CH.Digest CH.SHA256)) (rounds - 1)
-- | Computes the hmacSHA256 of the given message, with the given 'Salt'.
hmacSHA256 :: ByteString
@ -151,7 +154,7 @@ hmacSHA256 :: ByteString
-> ByteString
-- ^ The encoded message
hmacSHA256 secret msg =
toBytes (CH.hmacGetDigest (CH.hmac secret msg) :: CH.Digest CH.SHA256)
convert (CH.hmacGetDigest (CH.hmac secret msg) :: CH.Digest CH.SHA256)
-- | PBKDF2 key-derivation function.
-- For details see @http://tools.ietf.org/html/rfc2898@.

View File

@ -1,5 +1,5 @@
name: yesod-auth
version: 1.4.17
version: 1.4.17.2
license: MIT
license-file: LICENSE
author: Michael Snoyman, Patrick Brisbin
@ -27,7 +27,8 @@ library
, wai >= 1.4
, template-haskell
, base16-bytestring
, cryptohash
, cryptonite
, memory
, random >= 1.0.0.2
, text >= 0.7
, mime-mail >= 0.3
@ -37,8 +38,8 @@ library
, unordered-containers
, yesod-form >= 1.4 && < 1.5
, transformers >= 0.2.2
, persistent >= 2.1 && < 2.7
, persistent-template >= 2.1 && < 2.7
, persistent >= 2.1 && < 2.8
, persistent-template >= 2.1 && < 2.8
, http-client
, http-conduit >= 2.1
, aeson >= 0.7

View File

@ -1,3 +1,7 @@
## 1.5.2.3
* Fix race condition which leads dev server to stay in compilation mode. [#1380](https://github.com/yesodweb/yesod/issues/1380)
## 1.5.2.2
* I guess `--no-nix-pure` implies Nix... sigh [#1359](https://github.com/yesodweb/yesod/issues/1359)

View File

@ -1,3 +1,4 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
@ -14,6 +15,7 @@ import Control.Concurrent.STM
import qualified Control.Exception.Safe as Ex
import Control.Monad (forever, unless, void,
when)
import Data.ByteString (ByteString, isInfixOf)
import qualified Data.ByteString.Lazy as LB
import Data.Conduit (($$), (=$))
import qualified Data.Conduit.Binary as CB
@ -126,6 +128,7 @@ reverseProxy :: DevelOpts -> TVar Int -> IO ()
reverseProxy opts appPortVar = do
manager <- newManager $ managerSetProxy noProxy tlsManagerSettings
let refreshHtml = LB.fromChunks [$(embedFile "refreshing.html")]
sayV = when (verbose opts) . sayString
let onExc _ req
| maybe False (("application/json" `elem`) . parseHttpAccept)
(lookup "accept" $ requestHeaders req) =
@ -142,6 +145,7 @@ reverseProxy opts appPortVar = do
let proxyApp = waiProxyToSettings
(const $ do
appPort <- atomically $ readTVar appPortVar
sayV $ "revProxy: appPort " ++ (show appPort)
return $
ReverseProxy.WPRProxyDest
$ ProxyDest "127.0.0.1" appPort)
@ -222,6 +226,30 @@ checkDevelFile =
then return x
else loop xs
stackSuccessString :: ByteString
stackSuccessString = "ExitSuccess"
stackFailureString :: ByteString
stackFailureString = "ExitFailure"
-- We need updateAppPort logic to prevent a race condition.
-- See https://github.com/yesodweb/yesod/issues/1380
updateAppPort :: ByteString -> TVar Bool -- ^ Bool to indicate if the
-- output from stack has
-- started. False indicate
-- that it hasn't started
-- yet.
-> TVar Int -> STM ()
updateAppPort bs buildStarted appPortVar = do
hasStarted <- readTVar buildStarted
let buildEnd = isInfixOf stackFailureString bs || isInfixOf stackSuccessString bs
case (hasStarted, buildEnd) of
(False, False) -> do
writeTVar appPortVar (-1 :: Int)
writeTVar buildStarted True
(True, False) -> return ()
(_, True) -> writeTVar buildStarted False
-- | Get the set of all flags available in the given cabal file
getAvailableFlags :: D.GenericPackageDescription -> Set.Set String
getAvailableFlags =
@ -283,6 +311,7 @@ devel opts passThroughArgs = do
sayV = when (verbose opts) . sayString
-- Leverage "stack build --file-watch" to do the build
runStackBuild :: TVar Int -> [Char] -> Set.Set [Char] -> IO ()
runStackBuild appPortVar packageName availableFlags = do
-- We call into this app for the devel-signal command
myPath <- getExecutablePath
@ -316,7 +345,7 @@ devel opts passThroughArgs = do
passThroughArgs
sayV $ show procConfig
buildStarted <- newTVarIO False
-- Monitor the stdout and stderr content from the build process. Any
-- time some output comes, we invalidate the currently running app by
-- changing the destination port for reverse proxying to -1. We also
@ -325,12 +354,13 @@ devel opts passThroughArgs = do
withProcess_ procConfig $ \p -> do
let helper getter h =
getter p
$$ CL.iterM (\_ -> atomically $ writeTVar appPortVar (-1))
$$ CL.iterM (\(str :: ByteString) -> atomically (updateAppPort str buildStarted appPortVar))
=$ CB.sinkHandle h
race_ (helper getStdout stdout) (helper getStderr stderr)
-- Run the inner action with a TVar which will be set to True
-- whenever the signal file is modified.
withChangedVar :: (TVar Bool -> IO a) -> IO a
withChangedVar inner = withManager $ \manager -> do
-- Variable indicating that the signal file has been changed. We
-- reset it each time we handle the signal.
@ -353,6 +383,7 @@ devel opts passThroughArgs = do
inner changedVar
-- Each time the library builds successfully, run the application
runApp :: TVar Int -> TVar Bool -> String -> IO b
runApp appPortVar changedVar develHsPath = do
-- Wait for the first change, indicating that the library
-- has been built

View File

@ -1,5 +1,5 @@
name: yesod-bin
version: 1.5.2.2
version: 1.5.2.3
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>

View File

@ -1,8 +1,12 @@
## 1.4.34
## 1.4.35
* Contexts can be included in generated TH instances. [1365](https://github.com/yesodweb/yesod/issues/1365)
* Type variables can be included in routes.
## 1.4.34
* Add `WaiSubsiteWithAuth`. [#1394](https://github.com/yesodweb/yesod/pull/1394)
## 1.4.33
* Adds curly brackets to route parser. [#1363](https://github.com/yesodweb/yesod/pull/1363)

View File

@ -10,7 +10,7 @@ import Yesod.Routes.Class
import qualified Network.Wai as W
import Yesod.Core.Types
import Yesod.Core.Content
import Yesod.Core.Handler (stripHandlerT)
import Yesod.Core.Handler (sendWaiApplication, stripHandlerT)
import Yesod.Core.Class.Yesod
import Yesod.Core.Class.Handler
@ -28,6 +28,15 @@ instance YesodSubDispatch WaiSubsite master where
where
WaiSubsite app = ysreGetSub $ yreSite ysreParentEnv
instance YesodSubDispatch WaiSubsiteWithAuth (HandlerT master IO) where
yesodSubDispatch YesodSubRunnerEnv {..} req =
ysreParentRunner base ysreParentEnv (fmap ysreToParentRoute route) req
where
base = stripHandlerT handlert ysreGetSub ysreToParentRoute route
route = Just $ WaiSubsiteWithAuthRoute (W.pathInfo req) []
WaiSubsiteWithAuth set = ysreGetSub $ yreSite $ ysreParentEnv
handlert = sendWaiApplication $ set
-- | A helper function for creating YesodSubDispatch instances, used by the
-- internal generated code. This function has been exported since 1.4.11.
-- It promotes a subsite handler to a wai application.

View File

@ -34,6 +34,7 @@ module Yesod.Core.Dispatch
, defaultMiddlewaresNoLogging
-- * WAI subsites
, WaiSubsite (..)
, WaiSubsiteWithAuth (..)
, subHelper
) where

View File

@ -175,9 +175,14 @@ type BottomOfHeadAsync master
type Texts = [Text]
-- | Wrap up a normal WAI application as a Yesod subsite.
-- | Wrap up a normal WAI application as a Yesod subsite. Ignore parent site's middleware and isAuthorized.
newtype WaiSubsite = WaiSubsite { runWaiSubsite :: W.Application }
-- | Like 'WaiSubsite', but applies parent site's middleware and isAuthorized.
--
-- @since 1.4.34
newtype WaiSubsiteWithAuth = WaiSubsiteWithAuth { runWaiSubsiteWithAuth :: W.Application }
data RunHandlerEnv site = RunHandlerEnv
{ rheRender :: !(Route site -> [(Text, Text)] -> Text)
, rheRoute :: !(Maybe (Route site))
@ -560,6 +565,14 @@ instance RenderRoute WaiSubsite where
instance ParseRoute WaiSubsite where
parseRoute (x, y) = Just $ WaiSubsiteRoute x y
instance RenderRoute WaiSubsiteWithAuth where
data Route WaiSubsiteWithAuth = WaiSubsiteWithAuthRoute [Text] [(Text,Text)]
deriving (Show, Eq, Read, Ord)
renderRoute (WaiSubsiteWithAuthRoute ps qs) = (ps,qs)
instance ParseRoute WaiSubsiteWithAuth where
parseRoute (x, y) = Just $ WaiSubsiteWithAuthRoute x y
data Logger = Logger
{ loggerSet :: !LoggerSet
, loggerDate :: !DateCacheGetter

View File

@ -1,5 +1,5 @@
name: yesod-core
version: 1.4.34
version: 1.4.35
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@ -21,7 +21,7 @@ extra-source-files:
README.md
library
build-depends: base >= 4.6 && < 5
build-depends: base >= 4.7 && < 5
, time >= 1.1.4
, wai >= 3.0
, wai-extra >= 3.0.7

View File

@ -1,3 +1,7 @@
## 1.4.12
* Password field does not remember its previous value
## 1.4.11
* Fix warnings

View File

@ -267,9 +267,9 @@ $newline never
passwordField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field m Text
passwordField = Field
{ fieldParse = parseHelper $ Right
, fieldView = \theId name attrs val isReq -> toWidget [hamlet|
, fieldView = \theId name attrs _ isReq -> toWidget [hamlet|
$newline never
<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="" value="#{either id id val}">
<input id="#{theId}" name="#{name}" *{attrs} type="password" :isReq:required="">
|]
, fieldEnctype = UrlEncoded
}

View File

@ -0,0 +1,26 @@
{-# LANGUAGE OverloadedStrings #-}
module Yesod.Form.I18n.Chinese where
import Yesod.Form.Types (FormMessage (..))
import Data.Monoid (mappend)
import Data.Text (Text)
chineseFormMessage :: FormMessage -> Text
chineseFormMessage (MsgInvalidInteger t) = "无效的整数: " `Data.Monoid.mappend` t
chineseFormMessage (MsgInvalidNumber t) = "无效的数字: " `mappend` t
chineseFormMessage (MsgInvalidEntry t) = "无效的条目: " `mappend` t
chineseFormMessage MsgInvalidTimeFormat = "无效的时间, 必须符合HH:MM[:SS]格式"
chineseFormMessage MsgInvalidDay = "无效的日期, 必须符合YYYY-MM-DD格式"
chineseFormMessage (MsgInvalidUrl t) = "无效的链接: " `mappend` t
chineseFormMessage (MsgInvalidEmail t) = "无效的邮箱地址: " `mappend` t
chineseFormMessage (MsgInvalidHour t) = "无效的小时: " `mappend` t
chineseFormMessage (MsgInvalidMinute t) = "无效的分钟: " `mappend` t
chineseFormMessage (MsgInvalidSecond t) = "无效的秒: " `mappend` t
chineseFormMessage MsgCsrfWarning = "为了防备跨站请求伪造, 请确认表格提交."
chineseFormMessage MsgValueRequired = "此项必填"
chineseFormMessage (MsgInputNotFound t) = "输入找不到: " `mappend` t
chineseFormMessage MsgSelectNone = "<空>"
chineseFormMessage (MsgInvalidBool t) = "无效的逻辑值: " `mappend` t
chineseFormMessage MsgBoolYes = ""
chineseFormMessage MsgBoolNo = ""
chineseFormMessage MsgDelete = "删除?"

View File

@ -25,7 +25,7 @@ import Control.Arrow ((***))
type DText = [Text] -> [Text]
-- | Type for a form which parses a value of type @a@ with the base monad @m@
-- (usually your @Handler@). Can can compose this using its @Applicative@ instance.
-- (usually your @Handler@). Can compose this using its @Applicative@ instance.
newtype FormInput m a = FormInput { unFormInput :: HandlerSite m -> [Text] -> Env -> FileEnv -> m (Either DText a) }
instance Monad m => Functor (FormInput m) where
fmap a (FormInput f) = FormInput $ \c d e e' -> liftM (either Left (Right . a)) $ f c d e e'

View File

@ -1,5 +1,5 @@
name: yesod-form
version: 1.4.11
version: 1.4.12
license: MIT
license-file: LICENSE
author: Michael Snoyman <michael@snoyman.com>
@ -68,6 +68,7 @@ library
Yesod.Form.I18n.Russian
Yesod.Form.I18n.Dutch
Yesod.Form.I18n.Spanish
Yesod.Form.I18n.Chinese
-- FIXME Yesod.Helpers.Crud
ghc-options: -Wall

View File

@ -16,8 +16,8 @@ extra-source-files: README.md ChangeLog.md
library
build-depends: base >= 4 && < 5
, yesod-core >= 1.4.0 && < 1.5
, persistent >= 2.1 && < 2.7
, persistent-template >= 2.1 && < 2.7
, persistent >= 2.1 && < 2.8
, persistent-template >= 2.1 && < 2.8
, transformers >= 0.2.2
, blaze-builder
, conduit

View File

@ -246,7 +246,7 @@ staticFiles dir = mkStaticFiles dir
-- files @\"static\/js\/jquery.js\"@ and
-- @\"static\/css\/normalize.css\"@, you would use:
--
-- > staticFilesList \"static\" [\"js\/jquery.js\", \"css\/normalize.css\"]
-- > staticFilesList "static" ["js/jquery.js", "css/normalize.css"]
--
-- This can be useful when you have a very large number of static
-- files, but only need to refer to a few of them from Haskell.

View File

@ -1,3 +1,8 @@
## 1.5.6
* Add assertNotEq.
[#1375](https://github.com/yesodweb/yesod/pull/1375)
## 1.5.5
* Fix warnings

View File

@ -86,6 +86,7 @@ module Yesod.Test
-- * Assertions
, assertEqual
, assertNotEq
, assertEqualNoShow
, assertEq
@ -335,6 +336,17 @@ assertEq m a b =
"First argument: " ++ ppShow a ++ "\n" ++
"Second argument: " ++ ppShow b ++ "\n"
-- | Asserts that the two given values are not equal.
--
-- In case they are equal, error mesasge includes the values.
--
-- @since 1.5.6
assertNotEq :: (Eq a, Show a) => String -> a -> a -> YesodExample site ()
assertNotEq m a b =
liftIO $ HUnit.assertBool msg (a /= b)
where msg = "Assertion: " ++ m ++ "\n" ++
"Both arguments: " ++ ppShow a ++ "\n"
{-# DEPRECATED assertEqual "Use assertEq instead" #-}
assertEqual :: (Eq a) => String -> a -> a -> YesodExample site ()
assertEqual = assertEqualNoShow

View File

@ -1,5 +1,5 @@
name: yesod-test
version: 1.5.5
version: 1.5.6
license: MIT
license-file: LICENSE
author: Nubis <nubis@woobiz.com.ar>