Skip to content
Snippets Groups Projects
Commit 55d32e75 authored by Jean-Paul Calderone's avatar Jean-Paul Calderone
Browse files

Fix hanging test by paying for voucher

Also reduce duplication in the test implementation a bit
And add some more error case tests
And remove the old, no-longer used redemption parameter globals
Some Integers becomes Ints for intra-module consistency
parent 43410cc7
No related branches found
No related tags found
1 merge request!102Enforce a certain number of tokens on redemption
...@@ -8,7 +8,12 @@ ...@@ -8,7 +8,12 @@
module PaymentServer.Redemption module PaymentServer.Redemption
( RedemptionAPI ( RedemptionAPI
, Redeem(Redeem) , Redeem(Redeem)
, RedemptionConfig(RedemptionConfig) , RedemptionConfig
( RedemptionConfig
, redemptionConfigMaxCounter
, redemptionConfigTokensPerVoucher
, redemptionConfigIssue
)
, redemptionServer , redemptionServer
) where ) where
...@@ -98,7 +103,7 @@ data Result ...@@ -98,7 +103,7 @@ data Result
| DoubleSpend -- ^ A voucher has already been redeemed. | DoubleSpend -- ^ A voucher has already been redeemed.
| OtherFailure Text -- ^ Some other unrecognized failure mode. | OtherFailure Text -- ^ Some other unrecognized failure mode.
-- | Given counter was not in the expected range -- | Given counter was not in the expected range
| CounterOutOfBounds Integer Integer Integer | CounterOutOfBounds Int Int Int
| Succeeded PublicKey [Signature] Proof | Succeeded PublicKey [Signature] Proof
deriving (Show, Eq) deriving (Show, Eq)
...@@ -108,7 +113,7 @@ data Redeem ...@@ -108,7 +113,7 @@ data Redeem
= Redeem = Redeem
{ redeemVoucher :: Voucher -- ^ The voucher being redeemed. { redeemVoucher :: Voucher -- ^ The voucher being redeemed.
, redeemTokens :: [BlindedToken] -- ^ Tokens to be signed as part of this redemption. , redeemTokens :: [BlindedToken] -- ^ Tokens to be signed as part of this redemption.
, redeemCounter :: Integer -- ^ Counter tag on this redemption. , redeemCounter :: Int -- ^ Counter tag on this redemption.
} deriving (Show, Eq, Generic) } deriving (Show, Eq, Generic)
instance FromJSON Redeem where instance FromJSON Redeem where
...@@ -164,13 +169,6 @@ instance FromJSON Result where ...@@ -164,13 +169,6 @@ instance FromJSON Result where
then return DoubleSpend then return DoubleSpend
else return $ OtherFailure reason else return $ OtherFailure reason
-- | Limit the value for the counter value supplied during a voucher
-- redemption attempt. A counter in the range [0..maxCounter) is allowed.
maxCounter :: Integer
maxCounter = 16
tokensPerVoucher :: Integer
tokensPerVoucher = 50000
type RedemptionAPI = ReqBody '[JSON] Redeem :> Post '[JSON] Result type RedemptionAPI = ReqBody '[JSON] Redeem :> Post '[JSON] Result
...@@ -235,8 +233,8 @@ tokenCountForGroup numGroups totalTokens groupNumber = ...@@ -235,8 +233,8 @@ tokenCountForGroup numGroups totalTokens groupNumber =
-- (eg because the voucher was already redeemed). -- (eg because the voucher was already redeemed).
redeem :: VoucherDatabase d => RedemptionConfig -> d -> Redeem -> Handler Result redeem :: VoucherDatabase d => RedemptionConfig -> d -> Redeem -> Handler Result
redeem (RedemptionConfig numGroups tokensPerVoucher issue) database (Redeem voucher tokens counter) = redeem (RedemptionConfig numGroups tokensPerVoucher issue) database (Redeem voucher tokens counter) =
if counter < 0 || counter >= maxCounter then if counter < 0 || counter >= numGroups then
throwError $ jsonErr err400 (CounterOutOfBounds 0 maxCounter counter) throwError $ jsonErr err400 (CounterOutOfBounds 0 numGroups counter)
else else
case tokenCountForGroup numGroups tokensPerVoucher (fromIntegral counter) of case tokenCountForGroup numGroups tokensPerVoucher (fromIntegral counter) of
Nothing -> Nothing ->
...@@ -249,7 +247,8 @@ redeem (RedemptionConfig numGroups tokensPerVoucher issue) database (Redeem vouc ...@@ -249,7 +247,8 @@ redeem (RedemptionConfig numGroups tokensPerVoucher issue) database (Redeem vouc
fingerprint = fingerprintFromTokens tokens fingerprint = fingerprintFromTokens tokens
redeemOnce :: IO (Either RedeemError Bool) redeemOnce :: IO (Either RedeemError Bool)
redeemOnce = redeemVoucherWithCounter database voucher fingerprint counter redeemOnce =
redeemVoucherWithCounter database voucher fingerprint (fromIntegral counter)
redeem :: Handler Result redeem :: Handler Result
redeem = do redeem = do
......
...@@ -2,7 +2,8 @@ ...@@ -2,7 +2,8 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module FakeStripe module FakeStripe
( withFakeStripe ( ChargeId(ChargeId)
, withFakeStripe
, chargeOkay , chargeOkay
, chargeFailed , chargeFailed
) where ) where
...@@ -43,6 +44,10 @@ import Web.Stripe.Client ...@@ -43,6 +44,10 @@ import Web.Stripe.Client
, Endpoint(Endpoint) , Endpoint(Endpoint)
) )
import Web.Stripe.Types
( ChargeId(ChargeId)
)
anError :: ByteString anError :: ByteString
anError = [r| anError = [r|
{ {
......
...@@ -43,22 +43,26 @@ import Network.Wai ...@@ -43,22 +43,26 @@ import Network.Wai
import PaymentServer.Issuer import PaymentServer.Issuer
( trivialIssue ( trivialIssue
) )
import PaymentServer.Persistence import PaymentServer.Persistence
( memory ( memory
) , payForVoucher
import PaymentServer.Server
( RedemptionConfig(RedemptionConfig)
, paymentServerApp
) )
import PaymentServer.Redemption import PaymentServer.Redemption
( Redeem(Redeem) ( Redeem(Redeem)
, RedemptionConfig
( RedemptionConfig
, redemptionConfigMaxCounter
, redemptionConfigTokensPerVoucher
, redemptionConfigIssue
)
)
import PaymentServer.Server
( paymentServerApp
) )
import FakeStripe import FakeStripe
( withFakeStripe ( withFakeStripe
, chargeOkay , chargeOkay
, ChargeId(ChargeId)
) )
tests :: TestTree tests :: TestTree
...@@ -72,29 +76,45 @@ redemptionTests = ...@@ -72,29 +76,45 @@ redemptionTests =
[ testCase "success" $ [ testCase "success" $
-- A redemption attempt with a valid group number and correct token count -- A redemption attempt with a valid group number and correct token count
-- for that group receives a 200 HTTP response. -- for that group receives a 200 HTTP response.
withFakeStripe (return chargeOkay) $ let redemption = Redeem aVoucher (replicate tokensPerGroup aToken) 0
\stripeConfig -> do in assertRedemptionStatus redemption 200
db <- memory
let app = paymentServerApp origins stripeConfig redemptionConfig db
(flip runSession) app $ do
response <- request $ Redeem "abc" (replicate (1024 `div` 16) "a") 0
assertStatus 200 response
, testCase "negative counter" $ , testCase "negative counter" $
-- A redemption attempt with a negative counter value fails with an HTTP -- A redemption attempt with a negative counter value fails with an HTTP
-- error. -- error.
withFakeStripe (return chargeOkay) $ let redemption = Redeem aVoucher (replicate tokensPerGroup aToken) (-1)
\stripeConfig -> do in assertRedemptionStatus redemption 400
db <- memory
let app = paymentServerApp origins stripeConfig redemptionConfig db , testCase "counter too large" $
-- A redemption attempt with a counter value greater than the maximum
(flip runSession) app $ do -- allowed fails with an HTTP error.
response <- request $ Redeem "abc" (replicate (1024 `div` 16) "a") (-1) let redemption = Redeem aVoucher (replicate tokensPerGroup aToken) tokenGroups
assertStatus 400 response in assertRedemptionStatus redemption 400
, testCase "too few tokens" $
-- A redemption attempt with fewer tokens than are expected in the
-- indicated redemption group fails with an HTTP error.
let redemption = Redeem aVoucher (replicate (tokensPerGroup - 1) aToken) 0
in assertRedemptionStatus redemption 400
, testCase "too many tokens" $
-- A redemption attempt with more tokens than are expected in the
-- indicated redemption group fails with an HTTP error.
let redemption = Redeem aVoucher (replicate (tokensPerGroup + 1) aToken) 0
in assertRedemptionStatus redemption 400
] ]
where where
redemptionConfig = RedemptionConfig 16 1024 trivialIssue totalTokens = 32
tokenGroups = 4
tokensPerGroup = totalTokens `div` tokenGroups
aToken = "a"
aVoucher = "abc"
redemptionConfig = RedemptionConfig
{ redemptionConfigMaxCounter = tokenGroups
, redemptionConfigTokensPerVoucher = totalTokens
, redemptionConfigIssue = trivialIssue
}
origins = ["example.invalid"] origins = ["example.invalid"]
headers = [("origin", "example.invalid"), ("content-type", "application/json")] headers = [("origin", "example.invalid"), ("content-type", "application/json")]
path = "/v1/redeem" path = "/v1/redeem"
...@@ -104,3 +124,17 @@ redemptionTests = ...@@ -104,3 +124,17 @@ redemptionTests =
} path } path
request = srequest . SRequest theRequest . encode request = srequest . SRequest theRequest . encode
-- | Assert that using the given redemption parameters results in a
-- response with the given status.
assertRedemptionStatus redemption expectedStatus =
withFakeStripe (return chargeOkay) $
\stripeConfig -> do
db <- memory
payForVoucher db aVoucher (return $ Right $ ChargeId "xyz")
let app = paymentServerApp origins stripeConfig redemptionConfig db
(flip runSession) app $ do
response <- request redemption
assertStatus expectedStatus response
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment