@@ -12,8 +12,7 @@ module Web.Connexpay.Payments ( CreditCard(..)
1212 , returnPayment
1313 ) where
1414
15−import Control.Exception (throwIO)
16−import Control.Monad (when)
15+import Control.Monad (when,void)
1716import Control.Monad.Except (throwError)
1817import Control.Monad.Reader (asks)
1918import Control.Monad.Writer.Strict
@@ -63,10 +62,8 @@ padDate :: Text -> Text
6362padDate t | Text.length t == 1 = "0" <> t
6463 | otherwise = t
6564
66−sendRequest' :: HttpResponse resp
67− => Proxy resp -> Text -> (forall scheme. Option scheme) -> [Pair]
68− -> ConnexpayM resp
69−sendRequest' resp endpoint opts body =
65+sendRequest' :: HttpResponse resp => Proxy resp -> Text -> [Pair] -> ConnexpayM resp
66+sendRequest' resp endpoint body =
7067 do mtok <- bearerToken
7168 tok <- case mtok of
7269 Just t -> pure t
@@ -74,13 +71,13 @@ sendRequest' resp endpoint opts body =
7471 host <- asks (.url)
7572 tls <- asks (.useTLS)
7673 let auth = header "Authorization" ("Bearer " <> Text.encodeUtf8 tok)
77− headers = auth <> opts
7874 url s = s host /: "api" /: "v1" /: endpoint
7975 obj <- object <$> addGuid body
8076 let jbody = ReqBodyJson obj
8177 r <- if tls
82− then reqCb POST (url https) jbody resp headers (logRequest obj)
83− else reqCb POST (url http) jbody resp headers (logRequest obj)
78+ then reqCb POST (url https) jbody resp auth (logRequest obj)
79+ else reqCb POST (url http) jbody resp auth (logRequest obj)
80+ logResponse r
8481 pure r
8582 where
8683 addGuid b =
@@ -106,21 +103,11 @@ sendRequest' resp endpoint opts body =
106103 $ c
107104 replaceCard v = v
108105
109−sendRequestJson :: FromJSON a => Text -> [Pair] -> ConnexpayM a
110−sendRequestJson endpoint body = do
111− r <- sendRequest' lbsResponse endpoint accept body
112− let b = responseBody r
113− logResponseBody r b
114− case eitherDecode b of
115− Right x -> return x
116− Left e -> liftIO (throwIO (JsonHttpException e))
117− where
118− accept = header "Accept" "application/json"
106+sendRequestJson :: FromJSON a => Text -> [Pair] -> ConnexpayM (JsonResponse a)
107+sendRequestJson = sendRequest' jsonResponse
119108
120109sendRequest_ :: Text -> [Pair] -> ConnexpayM ()
121−sendRequest_ ep body = do
122− r <- sendRequest' ignoreResponse ep mempty body
123− logResponse r
110+sendRequest_ ep = void . sendRequest' ignoreResponse ep
124111
125112data AuthResponse = AuthResponse { paymentGuid :: AuthOnlyGuid
126113 , status :: TransactionStatus
@@ -146,7 +133,8 @@ authorisePayment :: CreditCard -- ^ Credit card details (see 'CreditCard')
146133 -> Maybe Text -- ^ Merchant description that will appear in a customer's statement.
147134 -> ConnexpayM AuthResponse
148135authorisePayment cc amt invoice vendor =
149− do rbody <- sendRequestJson "authonlys" body
136+ do resp <- sendRequestJson "authonlys" body
137+ let rbody = responseBody resp
150138 -- Special case for Connexpay local transaction
151139 -- This status means that the transaction was registered,
152140 -- but Connexpay stopped its processing and it won't be
@@ -168,8 +156,7 @@ authorisePayment cc amt invoice vendor =
168156 -- should the need arise.
169157 tell [ "RiskData" .= KeyMap.empty @() ]
170158
171−data VoidRequest = VoidAuthorized AuthOnlyGuid
172− | VoidCaptured SaleGuid (Maybe (Money USD))
159+data VoidRequest = VoidAuthorized AuthOnlyGuid | VoidCaptured SaleGuid (Maybe (Money USD))
173160
174161-- | Void payment
175162voidPayment :: VoidRequest
@@ -206,7 +193,10 @@ instance FromJSON CaptureResponse where
206193-- | Capture payment, previously authorised through 'authorisePayment'.
207194capturePayment :: SaleGuid -- ^ Sales GUID, obtained from 'authorisePayment'.
208195 -> ConnexpayM CaptureResponse
209−capturePayment pid = sendRequestJson "Captures" body
196+capturePayment pid =
197+ do resp <- sendRequestJson "Captures" body
198+ let rbody = responseBody resp
199+ pure rbody
210200 where body = [ "AuthOnlyGuid" .= show pid
211201 , "ConnexPayTransaction" .= CPTransaction 1 ]
212202