fixup! [#25] Creating one connection manager for all BackendEffect …

…actions

app/Main.hs

@@ -29,16 +29,18 @@ import Config (configCodec, Config (..))
 import Entry (path, Entry)
 import System.Environment (lookupEnv)
 import Data.Maybe (fromMaybe)
-import Polysemy.State (State, evalState)
-import Network.HTTP.Client (Manager)
+import Network.HTTP.Client (Manager, defaultManagerSettings, newManager)
+import Polysemy.Reader (Reader, runReader)
+import Network.HTTP.Client.TLS (tlsManagerSettings)
 
 runBackendIO
-  :: Sem '[BackendEffect, Error CofferError, State (Maybe Manager), Embed IO, Final IO ] a
+  :: (Manager, Manager)
+  -> Sem '[BackendEffect, Error CofferError, Reader (Manager, Manager), Embed IO, Final IO ] a
   -> IO a
-runBackendIO action =
+runBackendIO managers action =
   runBackend action
     & errorToIOFinal @CofferError
-    & evalState Nothing
+    & runReader managers
     & embedToFinal @IO
     & runFinal
     >>= \case
@@ -71,7 +73,9 @@ main = do
   let someCommand = oSomeCommand options
   configPath <- getConfigPath options
   config <- readConfig configPath
-  runBackendIO do
+  defaultManager <- newManager defaultManagerSettings
+  tlsManager <- newManager tlsManagerSettings
+  runBackendIO (defaultManager, tlsManager) do
     case someCommand of
       SomeCommand cmd@CmdView{} -> do
         runCommand config cmd >>= \case

coffer.cabal

@@ -179,6 +179,7 @@ executable coffer
     , coffer
     , fmt
     , http-client
+    , http-client-tls
     , lens
     , optparse-applicative
     , polysemy

lib/Backend.hs

@@ -21,9 +21,9 @@ import Polysemy
 import Coffer.Path (EntryPath, Path)
 import BackendName (BackendName)
 import Network.HTTP.Client (Manager)
-import Polysemy.State (State)
+import Polysemy.Reader (Reader)
 
-type Effects r = (Member (Embed IO) r, Member (State (Maybe Manager)) r, Member (Error CofferError) r)
+type Effects r = (Member (Embed IO) r, Member (Reader (Manager, Manager)) r, Member (Error CofferError) r)
 
 class Show a => Backend a where
   _name :: a -> BackendName

lib/Backend/Vault/Kv.hs

@@ -23,8 +23,6 @@ import qualified Toml
 
 import           Control.Monad                (void)
 import           Servant.Client               (BaseUrl (BaseUrl), Scheme (Https, Http), mkClientEnv, ClientError (..), parseBaseUrl, showBaseUrl, ClientEnv)
-import           Network.HTTP.Client.TLS      (tlsManagerSettings)
-import           Network.HTTP.Client          (newManager, defaultManagerSettings, Manager, ManagerSettings)
 import           Polysemy.Error               (Error, throw)
 import           Toml                         (TomlCodec)
 import           GHC.Generics                 (Generic)
@@ -42,7 +40,7 @@ import Data.Either.Extra (eitherToMaybe, maybeToEither)
 import Data.Text (Text)
 import BackendName (BackendName, backendNameCodec)
 import Coffer.Util (didimatch)
-import Polysemy.State (get, put)
+import Polysemy.Reader (ask)
 
 data VaultKvBackend =
   VaultKvBackend
@@ -88,25 +86,14 @@ data CofferSpecials =
   deriving anyclass (A.ToJSON, A.FromJSON)
 makeLensesWith abbreviatedFields ''CofferSpecials
 
-getManager :: Effects r => ManagerSettings -> Sem r Manager
-getManager settings = do
-  managerMb <- get @(Maybe Manager)
-  case managerMb of
-    Nothing -> do
-      manager <- embed $ newManager settings
-      put (Just manager)
-      pure manager
-    Just manager -> pure manager
-
 getEnv :: Effects r => VaultKvBackend -> Sem r ClientEnv
-getEnv backend =
+getEnv backend = do
+  (defaultManager, tlsManager) <- ask
   case url of
     (BaseUrl Http _ _ _) -> do
-      manager <- getManager defaultManagerSettings
-      pure $ mkClientEnv manager url
+      pure $ mkClientEnv defaultManager url
     (BaseUrl Https _ _ _) -> do
-      manager <- getManager tlsManagerSettings
-      pure $ mkClientEnv manager url
+      pure $ mkClientEnv tlsManager url
   where
     url = vbAddress backend
 

package.yaml

@@ -120,6 +120,7 @@ executables:
       - coffer
       - fmt
       - http-client
+      - http-client-tls
       - lens
       - optparse-applicative
       - polysemy