mangopay 1.3 → 1.4

raw patch · 9 files changed

+117/−23 lines, 9 filesnew-uploader

Files

• mangopay.cabal +3/−2
• src/Web/MangoPay.hs +3/−0
• src/Web/MangoPay/Cards.hs +2/−2
• src/Web/MangoPay/Monad.hs +1/−1
• src/Web/MangoPay/Types.hs +58/−8
• test/Web/MangoPay/CardsTest.hs +17/−7
• test/Web/MangoPay/SimpleTest.hs +29/−0
• test/Web/MangoPay/TestUtils.hs +3/−3
• test/mangopay-tests.hs +1/−0

@@ -1,5 +1,5 @@ name:           mangopay-version:        1.3+version:        1.4 cabal-version:  >= 1.8 build-type:     Simple author:         JP Moresmau <jpmoresmau@gmail.com>@@ -123,7 +123,8 @@                   Web.MangoPay.CardsTest,                   Web.MangoPay.RefundsTest,                   Web.MangoPay.AccountsTest,-                  Web.MangoPay.PayoutsTest+                  Web.MangoPay.PayoutsTest,+                  Web.MangoPay.SimpleTest   hs-source-dirs:                   test,                   src

@@ -16,6 +16,9 @@         ,PagedList(..)         ,MPUsableMonad         ,ToHtQuery(..)+        ,CardExpiration(..)+        ,readCardExpiration+        ,writeCardExpiration                  -- access         ,createCredentialsSecret

@@ -35,7 +35,7 @@ -- | credit card information data CardInfo = CardInfo {   ciNumber :: Text-  ,ciExpire :: Text+  ,ciExpire :: CardExpiration   ,ciCSC :: Text   } deriving (Show,Read,Eq,Ord,Typeable) @@ -123,7 +123,7 @@   cId :: CardID   ,cCreationDate :: POSIXTime    ,cTag :: Maybe Text  -  ,cExpirationDate   :: Text -- ^  MMYY+  ,cExpirationDate   :: CardExpiration -- ^  MMYY   ,cAlias :: Text -- ^ Example: 497010XXXXXX4414   ,cCardProvider  :: Text -- ^ The card provider, it could be « CB », « VISA », « MASTERCARD », etc.   ,cCardType :: Text -- ^ « CB_VISA_MASTERCARD » is the only value available yet

@@ -213,7 +213,7 @@   let cr=CallRecord req' mpres   -- log call   $(logCall) cr-  return $ recordResult cr+  recordResult cr  -- | get a JSON response from a request to MangoPay -- MangoPay returns either a result, or an error

@@ -1,11 +1,13 @@-{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances, FlexibleInstances, TemplateHaskell #-}+{-# LANGUAGE DeriveDataTypeable, OverloadedStrings, ScopedTypeVariables, TypeSynonymInstances, FlexibleContexts, FlexibleInstances, TemplateHaskell, PatternGuards #-} -- | useful types and simple accessor functions module Web.MangoPay.Types where   import Control.Applicative-import Control.Exception.Base (Exception,throw)+import Control.Exception.Lifted (Exception, throwIO)+import Control.Monad.Base (MonadBase) import Data.Text as T hiding (singleton)+import Data.Text.Read as T import Data.Typeable (Typeable) import Data.ByteString  as BS (ByteString) import Data.Time.Clock.POSIX (POSIXTime)@@ -20,12 +22,14 @@ import Control.Monad.Logger import Data.Aeson.Encode (encodeToTextBuilder) import Data.Text.Lazy.Builder (fromText, toLazyText, singleton)-import Data.Monoid ((<>))+import Data.Monoid ((<>), mempty) import Data.Text.Lazy (toStrict)-import Data.String (fromString)+import Data.String (fromString, IsString) import qualified Data.Vector as V (length) import Language.Haskell.TH import Language.Haskell.TH.Syntax (qLocation)+import Text.Printf (printf)+import qualified Data.ByteString.Lazy as BS (toStrict)  -- | the MangoPay access point data AccessPoint = Sandbox | Production | Custom ByteString@@ -160,6 +164,46 @@ -- | alias for Currency type Currency=Text +-- | the expiration date of a card+data CardExpiration = CardExpiration {+  ceMonth :: Int+  ,ceYear :: Int+  }+  deriving (Show,Read,Eq,Ord,Typeable)++-- | read Card Expiration from text representation (MMYY)+readCardExpiration :: T.Reader CardExpiration+readCardExpiration t |+  4 == T.length t,+  (m,y)<-T.splitAt 2 t=do+    im<-T.decimal m+    iy<-T.decimal y+    return (CardExpiration (fst im) (fst iy), "")+readCardExpiration _ =Left "Incorrect length"++-- | write card expiration+writeCardExpiration :: CardExpiration -> Text+writeCardExpiration (CardExpiration m y)=let+  -- yes I know about text-format, but I don't think performance is that critical here to warrant another dependency+  sm=printf "%02d" $ checkRng m+  sy=printf "%02d" $ checkRng y+  in T.concat [pack sm, pack sy]+  where+    -- | check range fits in two digits+    checkRng :: Int -> Int+    checkRng i=if i > 99 then i `mod` 100 else i++-- | read Card Expiration from JSON string (MMYY)+instance FromJSON CardExpiration where+  parseJSON (String s) |+    Right (ce,"")<- readCardExpiration s=pure ce+  parseJSON _=fail "CardExpiration"++instance IsString CardExpiration where+  fromString s+    | Right (ce,"")<-readCardExpiration $ fromString s=ce+  fromString _=error "CardExpiration"+ -- | a structure holding the information of an API call data CallRecord a = CallRecord {     crReq :: H.Request -- ^ the request to MangoPay@@ -181,6 +225,12 @@   pathB=fromText $ TE.decodeUtf8 $ H.path req   -- log the query string if any   qsB=fromText $ TE.decodeUtf8 $ H.queryString req+  postB=if H.method req==HT.methodPost +    then case H.requestBody req of+      (H.RequestBodyBS b)->fromText (TE.decodeUtf8 b) <> " -> "+      (H.RequestBodyLBS b)->fromText $ TE.decodeUtf8 $ BS.toStrict b <> " -> "+      _->mempty+    else mempty   resB=case res of     -- log error     Left e->fromString $ show e@@ -189,14 +239,14 @@       Array arr->fromString (show $ V.length arr) <> " values"       -- we have a simple value we can log it       _->encodeToTextBuilder v-  in toStrict . toLazyText $ methB <> singleton ' ' <> pathB <> qsB <> ": " <> resB+  in toStrict . toLazyText $ methB <> singleton ' ' <> pathB <> qsB <> ": " <> postB <> resB  -- | the result -- if we have a proper result we return it -- if we have an error we throw it-recordResult :: CallRecord a-> a-recordResult (CallRecord _ (Left err))=throw err-recordResult (CallRecord _ (Right (_,a)))=a+recordResult :: MonadBase IO m => CallRecord a -> m a+recordResult (CallRecord _ (Left err))=throwIO err+recordResult (CallRecord _ (Right (_,a)))=return a  -- | log a CallRecord -- MonadLogger doesn't expose a function with a dynamic log level...

@@ -1,4 +1,4 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} {-# OPTIONS_GHC -F -pgmF htfpp #-} -- | test cards module Web.MangoPay.CardsTest where@@ -11,14 +11,23 @@ import Test.HUnit (Assertion)  import qualified Data.Text as T+import qualified Control.Exception.Lifted as L --- | test a card registration-test_Card :: Assertion-test_Card = do+-- | test a card registration using euro currency+test_CardEUR :: Assertion+test_CardEUR = doTestCard "EUR"++-- | test a card registration using dollar currency+test_CardUSD :: Assertion+test_CardUSD = doTestCard "USD"++-- | perform the actual test of card registration in the provided currency+doTestCard :: T.Text->Assertion+doTestCard curr=L.handle (\(e::MpException)->assertFailure (show e)) $ do   usL<-testMP $ listUsers (Just $ Pagination 1 1)   assertEqual 1 (length $ plData usL)   let uid=urId $ head $ plData usL-  let cr1=mkCardRegistration uid "EUR"+  let cr1=mkCardRegistration uid curr   cr2<-testMP $ storeCardRegistration cr1   assertBool (isJust $ crId cr2)   assertBool (isJust $ crCreationDate cr2)@@ -36,14 +45,15 @@   assertEqual cid $ cId c   assertBool $ not $ T.null $ cAlias c    assertBool $ not $ T.null $ cCardProvider c-  assertBool $ not $ T.null $ cExpirationDate c+  assertEqual (ciExpire testCardInfo1) (cExpirationDate c)+  --assertBool $ not $ T.null $ cExpirationDate c   assertEqual UNKNOWN $ cValidity c   assertBool $ cActive c   assertEqual uid $ cUserId c   assertEqual "CB_VISA_MASTERCARD" $ cCardType c   cs<-testMP $ getAll $ listCards uid   assertBool $ not $ null cs-  assertBool $ any (\ c1 -> cId c == cid) cs+  assertBool $ any (\ c1 -> cId c1 == cid) cs        

@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -F -pgmF htfpp #-}+module Web.MangoPay.SimpleTest where++import Web.MangoPay++import qualified Data.Text as T+import Test.Framework+import Test.HUnit (Assertion)+import Data.Either (rights)++-- | test serialization of card expiration+test_CardExpiration :: Assertion+test_CardExpiration = do+  let ece1=readCardExpiration "0225"+  assertBool $ not $ null $ rights [ece1]+  let Right (ce1,t1)=ece1+  assertBool $ T.null t1+  assertEqual (CardExpiration 2 25) ce1+  assertEqual "0225" $ writeCardExpiration ce1+  let ece2=readCardExpiration "1503"+  assertBool $ not $ null $ rights [ece2]+  let Right (ce2,t2)=ece2+  assertBool $ T.null t2+  assertEqual (CardExpiration 15 3) ce2+  assertEqual "1503" $ writeCardExpiration ce2+  let ce3 = CardExpiration 10 2034+  assertEqual "1034" $ writeCardExpiration ce3+  

@@ -130,7 +130,7 @@     res<-liftM tsReceivedEvents $ readIORef testState     a<-ops     mapM_ (testSearchEvent a) evtTs-    er<-waitForEvent res (map (testEvent a) evtTs) 5+    er<-waitForEvent res (map (testEvent a) evtTs) 30     assertEqual EventsOK er     return a @@ -235,7 +235,7 @@                         liftIO $ case mevt of                             Just evt->do                                 pushReceivedEvent revts $ Right evt-                                print evt+                                putStrLn $ "Received event:" ++ show evt                             Nothing->pushReceivedEvent revts $ Left $ UnhandledNotification $ show $ W.queryString req                 return $ W.responseBuilder status200 [("Content-Type", "text/plain")] $ copyByteString "noop" @@ -268,7 +268,7 @@             "accessKeyRef" ?+ ak             ,"data" ?+ pre             ,"cardNumber" ?+ ciNumber ci-            ,"cardExpirationDate" ?+ ciExpire ci+            ,"cardExpirationDate" ?+ (writeCardExpiration $ ciExpire ci)             ,"cardCvx" ?+ ciCSC ci]     let req'=req {H.method=HT.methodPost          , H.requestHeaders=[("content-type","application/x-www-form-urlencoded")]

@@ -5,6 +5,7 @@  import Test.Framework +import {-@ HTF_TESTS @-} Web.MangoPay.SimpleTest import {-@ HTF_TESTS @-} Web.MangoPay.AccessTest import {-@ HTF_TESTS @-} Web.MangoPay.UsersTest import {-@ HTF_TESTS @-} Web.MangoPay.WalletsTest