yesod-mangopay 1.3 → 1.4
raw patch · 4 files changed
+50/−23 lines, 4 filesdep ~lifted-basedep ~mangopaynew-uploader
Dependency ranges changed: lifted-base, mangopay
Files
- app/Foundation.hs +12/−0
- app/Handler/Card.hs +32/−17
- src/Yesod/MangoPay.hs +2/−2
- yesod-mangopay.cabal +4/−4
app/Foundation.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE ScopedTypeVariables #-} module Foundation where import Prelude@@ -150,3 +151,14 @@ mpHttpManager=httpManager mpUseSandbox=mpSandbox . appExtra . settings mpToken=appToken++-- | show an error page on a mangopay error+catchW :: (Yesod site, RenderMessage site AppMessage) =>+ HandlerT site IO Html -> HandlerT site IO Html+catchW a=catchMP a (\e->+ defaultLayout $ do+ $(logError) "in error handler"+ let exception=show e+ setTitleI MsgRequestFail+ $(widgetFile "request_fail"))+
app/Handler/Card.hs view
@@ -13,12 +13,14 @@ import Control.Monad (liftM) import Network.Wai (rawQueryString) import Data.Text (pack)+import Control.Arrow ((&&&)) -- | get card list getCardsR :: AnyUserID -> Handler Html getCardsR uid=do -- no paging, should be reasonable cards<-runYesodMPTToken $ getAll $ listCards uid+ ((_,widget), enctype) <- generateFormGet currencyForm defaultLayout $ do aDomId <- newIdent setTitleI MsgTitleCards@@ -40,23 +42,30 @@ -- we can also use the pure Ajax solution via the mangopay JS toolkit, but the iframe system should work in more browsers getCardR :: AnyUserID -> Handler Html getCardR uid=do- let cr1=mkCardRegistration uid "EUR" -- EUR mandated by Mangopay- -- step 1: store pending registration- cr2<-runYesodMPTToken $ storeCardRegistration cr1- let Just url = crCardRegistrationURL cr2 -- the url of the validation server- Just pre = crPreregistrationData cr2- Just ak = crAccessKey cr2- -- we keep the registration info in the session- setSession "cardReg" $ toStrict $ toLazyText $ encodeToTextBuilder $ toJSON cr2- -- generate hidden form- (widget, enctype) <- generateFormPost cardTokenForm- - defaultLayout $ do- aDomId <- newIdent- -- JQuery is useful!- addScriptRemote "https://ajax.googleapis.com/ajax/libs/jquery/1.9.0/jquery.min.js"- setTitleI MsgTitleCard- $(widgetFile "card")+ ((result, _), _) <- runFormGet currencyForm+ case result of+ FormSuccess curr->catchW $ do+ let cr1=mkCardRegistration uid curr+ -- step 1: store pending registration+ cr2<-runYesodMPTToken $ storeCardRegistration cr1+ let Just url = crCardRegistrationURL cr2 -- the url of the validation server+ Just pre = crPreregistrationData cr2+ Just ak = crAccessKey cr2+ -- we keep the registration info in the session+ setSession "cardReg" $ toStrict $ toLazyText $ encodeToTextBuilder $ toJSON cr2+ -- generate hidden form+ (widget, enctype) <- generateFormPost cardTokenForm+ + defaultLayout $ do+ aDomId <- newIdent+ -- JQuery is useful!+ addScriptRemote "https://ajax.googleapis.com/ajax/libs/jquery/1.9.0/jquery.min.js"+ setTitleI MsgTitleCard+ $(widgetFile "card")+ f ->do+ $(logError) $ pack $ show f+ setMessageI MsgErrorData+ redirect $ CardsR uid -- | this only dumps the query string -- this is used as the returnURL for the validation server@@ -105,3 +114,9 @@ cardTokenForm :: Html -> MForm Handler (FormResult Token, Widget) cardTokenForm = renderDivs $ Token <$> areq hiddenField (FieldSettings "" Nothing (Just "frmdat") (Just "frmdat") []) Nothing++-- | simple form for choosing the currency of the card registration+currencyForm :: Html -> MForm Handler (FormResult Currency, Widget)+currencyForm = renderDivs $ id+ <$> areq (selectFieldList (map (id &&& id) supportedCurrencies)) (localizedFS MsgCardCurrency) (Just "EUR")+
src/Yesod/MangoPay.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleContexts,TemplateHaskell, RankNTypes, ConstraintKinds #-}+{-# LANGUAGE OverloadedStrings, TypeFamilies, FlexibleContexts,TemplateHaskell, RankNTypes, ConstraintKinds, ScopedTypeVariables #-} -- | typeclasses and helpers to access MangoPay from Yesod module Yesod.MangoPay where @@ -145,4 +145,4 @@ catchMP :: forall (m :: * -> *) a. Y.MonadBaseControl IO m => m a -> (MpException -> m a) -> m a-catchMP func =L.catch func +catchMP=L.catch
yesod-mangopay.cabal view
@@ -1,5 +1,5 @@ name: yesod-mangopay-version: 1.3+version: 1.4 cabal-version: >= 1.8 build-type: Simple author: JP Moresmau <jpmoresmau@gmail.com>@@ -37,7 +37,7 @@ hs-source-dirs: src build-depends: base >= 4 && < 5- , mangopay == 1.2.*+ , mangopay == 1.4.* , containers >= 0.5 && < 0.6 , http-conduit >= 2.0 && < 2.2 , http-types >= 0.8.2 && < 0.9@@ -93,7 +93,6 @@ build-depends: base, containers, http-conduit, mangopay, text, time, yesod, yesod-core- , yesod-mangopay , aeson >= 0.6 && < 0.8 , bytestring >= 0.9 && < 0.11@@ -121,7 +120,8 @@ , yesod-auth >= 1.2.6 , yesod-form >= 1.3.0 && < 1.4 , yesod-persistent- , yesod-static >= 1.2 && < 1.3+ , yesod-static >= 1.2 && < 1.3,+ lifted-base >=0.2.2 && <0.3 if flag(conduit11) build-depends: conduit == 1.1.*