7d319d9 · typeable/connexpay

git.iko.soy/typeable/connexpay

on master help sign in

Allow dropping HTTPS (for debug purposes)

7d319d9Nick3 years ago

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

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

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

48 password <- asks (.password)

49 host <- asks (.url)

50+ tls <- asks (.useTLS)

50 let body = ReqBodyBs (mkAuthForm login password)

51 let body = ReqBodyBs (mkAuthForm login password)

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

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

53+ resp <-

54+ if tls

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

52− resp <- req POST url body jsonResponse mempty

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

53 let TokenReply tok ts = responseBody resp

57 let TokenReply tok ts = responseBody resp

54 pure (tok, ts)

58 pure (tok, ts)

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

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

60sendRequest' resp endpoint body =

61 do tok <- bearerToken

62 host <- asks (.url)

63+ tls <- asks (.useTLS)

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

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

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

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

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

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

67+ if tls

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

66− req POST url jbody resp auth

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

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

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

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

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