yesod-mangopay 1.2 → 1.3
raw patch · 3 files changed
+80/−30 lines, 3 files
Files
- app/Foundation.hs +3/−2
- app/Handler/Card.hs +76/−27
- yesod-mangopay.cabal +1/−1
app/Foundation.hs view
@@ -19,7 +19,7 @@ import Data.IORef (IORef) import Yesod.Form.Jquery (YesodJquery) import Network.Wai (pathInfo,Request)-import Data.Text (Text)+import Data.Text as T (Text) -- | The site argument for your application. This can be a good place to -- keep settings and values requiring initialization before your application@@ -60,11 +60,12 @@ type Form x = Html -> MForm (HandlerT App IO) (FormResult x, Widget) --- | use relative links unless if to register hook+-- | use relative links unless if to register hook or for card registration -- this is useful when developing since the external address may not be the local address approotRequest :: App -> Request -> Text approotRequest master request | pathInfo request==["runFakeHandler", "pathInfo"] = appRoot $ settings master+ | (not $ null $ pathInfo request) && (head (pathInfo request) == "card") = appRoot $ settings master | otherwise= "" -- Please see the documentation for the Yesod typeclass. There are a number
app/Handler/Card.hs view
@@ -4,7 +4,15 @@ import Import import Web.MangoPay import Yesod.MangoPay-import Control.Arrow ((&&&))+import Data.Aeson.Encode (encodeToTextBuilder)+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy.Builder (toLazyText)+import Data.Aeson (eitherDecode)+import qualified Data.Text.Encoding as TE+import Data.ByteString.Lazy (fromChunks)+import Control.Monad (liftM)+import Network.Wai (rawQueryString)+import Data.Text (pack) -- | get card list getCardsR :: AnyUserID -> Handler Html@@ -17,42 +25,83 @@ $(widgetFile "cards") -- | get card registration form+-- this form will not be sent to this server, but to the validation server!+-- we have an iframe in that page+-- the process is+-- 1. create a pending registration in Mangopay+-- 2. generate a credit card detail form sending data to the validation server, and a return url pointing to Card2R+-- 3. get the result in Card2R, dump it into the iframe+-- 4. get the iframe data via Javascript and submit it to CardR+-- The use of the iframe means the user only sees our page, not the validation server's+-- The use of Card2R ensure the iframe is considered by the browser as being populated by this server+-- So we can pick its contents via Javascript without breaking cross-domain security+-- and submit it back to us using the same session!+-- if we didn't have a iframe and redirect the main page via the validation server, we lose the session, so we would need to encode a token in the url+-- 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- (widget, enctype) <- generateFormPost cardInfoForm+ 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") --- | register card+-- | this only dumps the query string+-- this is used as the returnURL for the validation server+-- so that the iframe will be populated by content coming from this server+-- which allows Javascript to use it+getCard2R :: Handler TypedContent+getCard2R =do+ qs<-liftM rawQueryString waiRequest+ respond typePlain qs+ +-- | this gets the token via JavaScript submission postCardR :: AnyUserID -> Handler Html postCardR uid=do- ((result, widget), enctype) <- runFormPost cardInfoForm+ ((result, _), _) <- runFormPost cardTokenForm+ mjcr<-lookupSession "cardReg"+ deleteSession "cardReg" case result of- FormSuccess (c,ci)->- catchMP (do- _<-runYesodMPTToken $ fullRegistration uid c ci+ FormSuccess (Token dat)->+ case mjcr of+ Nothing->do+ $(logError) $ "lookupSession->Nothing"+ setMessageI MsgErrorData+ redirect $ CardR uid+ Just jcr->do+ let ecr=eitherDecode $ fromChunks [TE.encodeUtf8 jcr]+ case ecr of+ Right cr->do+ _<-runYesodMPTToken $ storeCardRegistration cr{crRegistrationData=Just dat} setMessageI MsgCardDone redirect $ CardsR uid- )- (\e->do- setMessage $ toHtml $ show e- defaultLayout $ do- aDomId <- newIdent- setTitleI MsgTitleCard- $(widgetFile "card")- )- _ -> do- setMessageI MsgErrorData- defaultLayout $ do- aDomId <- newIdent- setTitleI MsgTitleCard- $(widgetFile "card")+ Left err->do+ $(logError) $ pack err+ setMessageI MsgErrorData+ redirect $ CardR uid+ f ->do+ $(logError) $ pack $ show f+ setMessageI MsgErrorData+ redirect $ CardR uid++-- | token for card registration+data Token=Token Text+ deriving Show -cardInfoForm :: Html -> MForm Handler (FormResult (Currency,CardInfo), Widget)-cardInfoForm = renderDivs $ (\a b c d-> (a,CardInfo b c d))- <$> areq (selectFieldList (map (id &&& id) supportedCurrencies)) (localizedFS MsgCardCurrency) Nothing- <*> areq textField (localizedFS MsgCardNumber) Nothing- <*> areq textField (localizedFS MsgCardExpire) Nothing- <*> areq textField (localizedFS MsgCardCSC) Nothing +-- | simple form for card registration+-- the field is hidden and populated via JavaScript (card.julius)+cardTokenForm :: Html -> MForm Handler (FormResult Token, Widget)+cardTokenForm = renderDivs $ Token+ <$> areq hiddenField (FieldSettings "" Nothing (Just "frmdat") (Just "frmdat") []) Nothing
yesod-mangopay.cabal view
@@ -1,5 +1,5 @@ name: yesod-mangopay-version: 1.2+version: 1.3 cabal-version: >= 1.8 build-type: Simple author: JP Moresmau <jpmoresmau@gmail.com>