diff --git a/src/PaymentServer/Processors/Stripe.hs b/src/PaymentServer/Processors/Stripe.hs index 6c2b601c25ac3540b92b9026b107f3a2ea4f75c2..c0771337e72ae24c7dc37df58c44d0debf40a071 100644 --- a/src/PaymentServer/Processors/Stripe.hs +++ b/src/PaymentServer/Processors/Stripe.hs @@ -24,6 +24,9 @@ import Data.Text import Text.Printf ( printf ) +import Text.Read + ( readMaybe + ) import Data.Aeson ( ToJSON(toJSON) , FromJSON(parseJSON) @@ -43,7 +46,7 @@ import Servant.API , JSON , Post , (:>) - , (:<|>)(..) + , (:<|>)((:<|>)) ) import Web.Stripe.Event ( Event(Event, eventId, eventCreated, eventLiveMode, eventType, eventData, eventObject, eventPendingWebHooks, eventRequest) @@ -54,6 +57,7 @@ import Web.Stripe.Event import Web.Stripe.Types ( Charge(Charge, chargeMetaData) , MetaData(MetaData) + , Currency ) import Web.Stripe.Error ( StripeError(..) @@ -149,8 +153,9 @@ charge :: VoucherDatabase d => d -> StripePrivateKey -> Charges -> Handler Ackno charge d key (Charges token voucher amount currency) = do let config = StripeConfig (StripeKey key) Nothing tokenId = TokenId token + currency' <- getCurrency currency result <- liftIO $ stripe config $ - createCharge (Amount amount) (read (unpack currency)) + createCharge (Amount amount) currency' -&- tokenId -&- MetaData [("Voucher", voucher)] case result of @@ -167,3 +172,9 @@ charge d key (Charges token voucher amount currency) = do throwError err400 { errBody = "Voucher code mismatch" } _ -> throwError err400 { errBody = "Voucher code not found" } Left StripeError {} -> throwError err400 { errBody = "Stripe charge didn't succeed" } + where + getCurrency :: Text -> Handler Currency + getCurrency maybeCurrency = do + case readMaybe (unpack currency) of + Just currency' -> return currency' + Nothing -> throwError err400 { errBody = "Invalid currency specified" }