From 4b600d64b820e1ddad5f58633676fb29e3710b5f Mon Sep 17 00:00:00 2001
From: Daniel Schadt <kingdread@gmx.de>
Date: Thu, 15 Jul 2021 13:45:00 +0200
Subject: fix loadCredentials

1. This function used 'fail', which is rather bad - now it returns
   'Either'

2. The function was still hardwired to the specific filenames of the
   first prototypes.
---
 src/Cana.hs | 15 +++++++++------
 1 file changed, 9 insertions(+), 6 deletions(-)

(limited to 'src/Cana.hs')

diff --git a/src/Cana.hs b/src/Cana.hs
index ca87fa1..2e616ac 100644
--- a/src/Cana.hs
+++ b/src/Cana.hs
@@ -81,12 +81,15 @@ runGeminiServer :: Maybe HostName -- ^ Hostname to bind to.
                 -> IO (Either String ())
 runGeminiServer hostName serviceName credFile keyFile routes = do
   creds <- loadCredentials credFile keyFile
-  let vhost = VirtualHost {
-      vhostName        = "*"
-    , vhostCredentials = creds
-    , vhostRoutes      = routes
-    }
-  runGeminiServer' (mkGeminiServer hostName serviceName creds [vhost])
+  case creds of
+    Left l      -> return $ Left l
+    Right creds -> do
+      let vhost = VirtualHost {
+          vhostName        = "*"
+        , vhostCredentials = creds
+        , vhostRoutes      = routes
+        }
+      runGeminiServer' (mkGeminiServer hostName serviceName creds [vhost])
 
 -- | Run the Gemini server.
 --
-- 
cgit v1.2.3