From 9ff4728d4007bd79ba79351c46d15f44802916f0 Mon Sep 17 00:00:00 2001
From: Nick <nick@typeable.io>
Date: Wed, 5 Jun 2024 14:45:47 +0000
Subject: [PATCH] Fix token update code.

---
 connexpay/src/Tool.hs               | 11 +++++++----
 connexpay/src/Web/Connexpay/Init.hs |  3 ++-
 stack.yaml                          |  2 +-
 3 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/connexpay/src/Tool.hs b/connexpay/src/Tool.hs
index e4d6efa..d44290f 100644
--- a/connexpay/src/Tool.hs
+++ b/connexpay/src/Tool.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 
+import Control.Concurrent (yield)
 import Control.Monad
 import Control.Monad.IO.Class
 import Data.Aeson
@@ -34,6 +35,7 @@ instance FromJSON Config
 data Command = AuthSale CreditCard Centi
              | VoidSale SaleGuid
              | CaptureSale SaleGuid
+             | TestAuth
 
 data CmdLine = CmdLine { configPath :: FilePath
                        , operation :: Command
@@ -45,6 +47,7 @@ cmdParser = CmdLine <$> strOption (short 'c' <> metavar "FILE" <> help "Configur
   where operation = command "auth" (info (AuthSale <$> cc <*> amt) (progDesc "Authorise payment"))
                  <> command "void" (info (VoidSale <$> guid) (progDesc "Void payment"))
                  <> command "capture" (info (CaptureSale <$> guid) (progDesc "Void payment"))
+                 <> command "test-auth" (info (pure TestAuth) (progDesc "Test token authorisation"))
         amt = argument auto (metavar "Payment amount")
         cc = CreditCard <$> argument str mempty
                         <*> fmap pure (argument str mempty)
@@ -55,8 +58,6 @@ cmdParser = CmdLine <$> strOption (short 'c' <> metavar "FILE" <> help "Configur
                      pure (read (take 2 s), read (drop 2 s))
         guid = argument auto (metavar "Payment UUID")
 
-
-
 writeLog :: Text -> IO ()
 writeLog msg = Text.putStrLn ("Connexpay log: " <> msg)
 
@@ -75,8 +76,10 @@ main = do cmdLine <- execParser (info cmdParser mempty)
             Right cpi -> print =<< runConnexpay cpi (doThing cmdLine.operation)
 
 doThing :: Command -> ConnexpayM ()
-doThing (AuthSale cc amt) = liftIO . print =<< authorisePayment cc usd (Just pnr) Nothing
+doThing (AuthSale cc amt) = liftIO . print =<< authorisePayment cc usd pnr vendor
   where usd = Money amt
-        pnr = "PNRPNR"
+        pnr = Just "PNRPNR"
+        vendor = Just "Typeable"
 doThing (VoidSale guid) = liftIO . print =<< voidPayment guid Nothing
 doThing (CaptureSale guid) = liftIO . print =<< capturePayment guid
+doThing TestAuth = liftIO (forever yield)
diff --git a/connexpay/src/Web/Connexpay/Init.hs b/connexpay/src/Web/Connexpay/Init.hs
index 4706919..2002700 100644
--- a/connexpay/src/Web/Connexpay/Init.hs
+++ b/connexpay/src/Web/Connexpay/Init.hs
@@ -8,6 +8,7 @@ import Web.Connexpay.Utils
 
 import Control.Concurrent
 import Control.Concurrent.Async
+import Control.Monad (void)
 import Control.Monad.Except (catchError)
 import Control.Monad.IO.Class
 import Control.Monad.Reader (asks)
@@ -49,7 +50,7 @@ updateToken w = liftIO (threadDelay w') >> upd
         upd = do (tok, ts) <- authenticate
                  logf <- asks (.logAction)
                  tokVar <- asks (.bearerToken)
-                 liftIO (putMVar tokVar tok)
+                 liftIO (void $ swapMVar tokVar tok)
                  liftIO (logf "Connexpay token update success")
                  updateToken (ts - 5)
               `catchError` \err -> do
diff --git a/stack.yaml b/stack.yaml
index d4230f1..46a073b 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -1,4 +1,4 @@
-resolver: lts-22.13
+resolver: lts-22.24
 
 packages:
 - connexpay