git.iko.soy/typeable/connexpay
on master help sign in
Allow starting without bearer token.

This is useful when the service needs to be able to start while Connexpay is offline.

commit973c6c70b564959c2bfb00e728bdf7b12e35ee5d authorNick <nick@typeable.io> dateTue 12 Nov 2024, 21:58 (2 years ago) parent82a2166
4 files changed+25−10
connexpay/src/Web/Connexpay/Data.hs+1 connexpay/src/Web/Connexpay/Init.hs+18−7 connexpay/src/Web/Connexpay/Payments.hs+4−1 connexpay/src/Web/Connexpay/Types.hs+2−2
connexpay/src/Web/Connexpay/Data.hs+1
@@ -80,6 +80,7 @@ instance FromJSON ErrorMessage where
8080data ConnectionError = ParseError String
8181 | InvalidUrl String String
8282 | HttpFailure HttpExceptionContent
83+ | TokenError String
8384 deriving Show
8485
8586-- | Error type for Connexpay.
connexpay/src/Web/Connexpay/Init.hs+18−7
@@ -1,5 +1,5 @@
11{-# LANGUAGE OverloadedStrings #-}
2−module Web.Connexpay.Init where
2+module Web.Connexpay.Init (initConnexpay) where
33
44import Web.Connexpay.Auth
55import Web.Connexpay.Data
@@ -26,7 +26,7 @@ initConnexpay :: (Text -> IO ()) -- ^ Logging function
2626 -> Text -- ^ Password.
2727 -> IO (Either ConnexpayError Connexpay)
2828initConnexpay logf mgr devguid url tls login password =
29− do v <- newEmptyMVar
29+ do v <- newMVar Nothing
3030 let env = Connexpay { logAction = logf
3131 , manager = mgr
3232 , bearerToken = v
@@ -38,19 +38,30 @@ initConnexpay logf mgr devguid url tls login password =
3838 , password = password
3939 }
4040 runConnexpay env $ do
41− (tok, ts) <- authenticate
42− a <- liftIO $ do logf "Connexpay authentication success"
43− putMVar v tok
44− async (runConnexpay_ env $ updateToken ts)
41+ ts <- initialAuth v logf
42+ a <- liftIO (async (runConnexpay_ env $ updateToken ts))
4543 pure (env { refreshAsync = Just a })
4644
45+initialAuth :: MVar (Maybe BearerToken) -> (Text -> IO ()) -> ConnexpayM Natural
46+initialAuth v logf =
47+ do (tok, ts) <- authenticate
48+ liftIO $ do logf "Connexpay authentication success"
49+ void (swapMVar v (Just tok))
50+ return ts
51+ `catchError` \err -> do
52+ liftIO (logf ("Initial connexpay authentication failed: " <> tshow err))
53+ -- if initial authentication failed, wait 1 second?
54+ -- there isn't much else to do, really.
55+ return 1
56+
57+
4758updateToken :: Natural -> ConnexpayM ()
4859updateToken w = liftIO (threadDelay w') >> upd
4960 where w' = fromIntegral w * 1000000
5061 upd = do (tok, ts) <- authenticate
5162 logf <- asks (.logAction)
5263 tokVar <- asks (.bearerToken)
53− liftIO (void $ swapMVar tokVar tok)
64+ liftIO (void $ swapMVar tokVar (Just tok))
5465 liftIO (logf "Connexpay token update success")
5566 updateToken (ts - 5)
5667 `catchError` \err -> do
connexpay/src/Web/Connexpay/Payments.hs+4−1
@@ -64,7 +64,10 @@ padDate t | Text.length t == 1 = "0" <> t
6464
6565sendRequest' :: HttpResponse resp => Proxy resp -> Text -> [Pair] -> ConnexpayM resp
6666sendRequest' resp endpoint body =
67− do tok <- bearerToken
67+ do mtok <- bearerToken
68+ tok <- case mtok of
69+ Just t -> pure t
70+ Nothing -> throwError (ConnectionError $ TokenError "No authentication token available. Check connection parameters?")
6871 host <- asks (.url)
6972 tls <- asks (.useTLS)
7073 let auth = header "Authorization" ("Bearer " <> Text.encodeUtf8 tok)
connexpay/src/Web/Connexpay/Types.hs+2−2
@@ -25,7 +25,7 @@ type CaptureGuid = UUID
2525
2626data Connexpay = Connexpay { logAction :: Text -> IO ()
2727 , manager :: Manager
28− , bearerToken :: MVar BearerToken
28+ , bearerToken :: MVar (Maybe BearerToken)
2929 , refreshAsync :: Maybe (Async ())
3030 , deviceGuid :: DeviceGuid
3131 , url :: Text
@@ -58,7 +58,7 @@ runConnexpay_ cp m =
5858 whenLeft r $ \err ->
5959 cp.logAction ("Uncaught Connexpay error: " <> Text.pack (show err))
6060
61−bearerToken :: ConnexpayM BearerToken
61+bearerToken :: ConnexpayM (Maybe BearerToken)
6262bearerToken = do v <- asks (.bearerToken)
6363 liftIO (readMVar v)
6464