7d319d9 · typeable/connexpay

git.iko.soy/typeable/connexpay

Allow dropping HTTPS (for debug purposes)

commit7d319d995c9dae6707ae2557ef7f6c17f0a29c3c authorNick <nick@typeable.io> dateSun 24 Mar 2024, 00:13 (3 years ago) parent450606b

2 files changed+11−4

unifiedsplit

src/Web/Connexpay/Auth.hs+6−2

@@ -47,8 +47,12 @@ authenticate :: ConnexpayM (BearerToken, Natural)

4747authenticate = do login <- asks (.login)

4848 password <- asks (.password)

4949 host <- asks (.url)

50+ tls <- asks (.useTLS)

5051 let body = ReqBodyBs (mkAuthForm login password)

51− url = https host /: "api" /: "v1" /: "token"

52− resp <- req POST url body jsonResponse mempty

52+ url s = s host /: "api" /: "v1" /: "token"

53+ resp <-

54+ if tls

55+ then req POST (url https) body jsonResponse mempty

56+ else req POST (url http) body jsonResponse mempty

5357 let TokenReply tok ts = responseBody resp

5458 pure (tok, ts)

src/Web/Connexpay/Payments.hs+5−2

@@ -60,10 +60,13 @@ sendRequest' :: HttpResponse resp => Proxy resp -> Text -> [Pair] -> ConnexpayM

6060sendRequest' resp endpoint body =

6161 do tok <- bearerToken

6262 host <- asks (.url)

63+ tls <- asks (.useTLS)

6364 let auth = header "Authorization" ("Bearer " <> Text.encodeUtf8 tok)

64− url = https host /: "api" /: "v1" /: endpoint

65+ url s = s host /: "api" /: "v1" /: endpoint

6566 jbody <- ReqBodyJson . object <$> addGuid body

66− req POST url jbody resp auth

67+ if tls

68+ then req POST (url https) jbody resp auth

69+ else req POST (url http) jbody resp auth

6770 where addGuid b = do guid <- asks (.deviceGuid)

6871 return (b <> [ "DeviceGuid" .= show guid ])

6972