From 52971e4b6fe9c250650549b88add755caa502930 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Sun, 21 Oct 2012 07:11:46 +0200
Subject: [PATCH] Removed host list on Keter welcome page

---
 Keter/Main.hs        |  2 --
 Keter/PortManager.hs | 11 -----------
 Keter/Proxy.hs       | 27 +++++++--------------------
 3 files changed, 7 insertions(+), 33 deletions(-)

diff --git a/Keter/Main.hs b/Keter/Main.hs
index aeef4d3..c684d8a 100644
--- a/Keter/Main.hs
+++ b/Keter/Main.hs
@@ -87,14 +87,12 @@ keter input' = do
     _ <- forkIO $ Proxy.reverseProxy
             (serverSettings configPort configHost)
             (runKIOPrint . PortMan.lookupPort portman)
-            (runKIOPrint $ PortMan.hostList portman)
     case configSsl of
         Nothing -> return ()
         Just ssl -> do
             _ <- forkIO $ Proxy.reverseProxySsl
                     (Proxy.setDir dir ssl)
                     (runKIOPrint . PortMan.lookupPort portman)
-                    (runKIOPrint $ PortMan.hostList portman)
             return ()
 
     mappMap <- M.newMVar Map.empty
diff --git a/Keter/PortManager.hs b/Keter/PortManager.hs
index 94cc117..728462e 100644
--- a/Keter/PortManager.hs
+++ b/Keter/PortManager.hs
@@ -18,7 +18,6 @@ module Keter.PortManager
     , addEntry
     , removeEntry
     , lookupPort
-    , hostList
       -- * Initialize
     , start
     ) where
@@ -46,7 +45,6 @@ data Command = GetPort (Either SomeException Port -> KIO ())
              | AddEntry Host PortEntry
              | RemoveEntry Host
              | LookupPort S.ByteString (Maybe PortEntry -> KIO ())
-             | HostList ([S.ByteString] -> KIO ())
 
 -- | An abstract type which can accept commands and sends them to a background
 -- nginx thread.
@@ -110,9 +108,6 @@ start Settings{..} = do
             LookupPort h f -> do
                 NState {..} <- S.get
                 lift $ f $ Map.lookup h nsEntries
-            HostList f -> do
-                NState {..} <- S.get
-                lift $ f $ Map.keys nsEntries
     return $ Right $ PortManager $ writeChan chan
   where
     change f = do
@@ -158,9 +153,3 @@ lookupPort (PortManager f) h = do
     x <- newEmptyMVar
     f $ LookupPort h $ \p -> putMVar x p
     takeMVar x
-
-hostList :: PortManager -> KIO [S.ByteString]
-hostList (PortManager f) = do
-    x <- newEmptyMVar
-    f $ HostList $ \p -> putMVar x p
-    takeMVar x
diff --git a/Keter/Proxy.hs b/Keter/Proxy.hs
index d25fdbe..2d4e2d6 100644
--- a/Keter/Proxy.hs
+++ b/Keter/Proxy.hs
@@ -3,14 +3,12 @@
 module Keter.Proxy
     ( reverseProxy
     , PortLookup
-    , HostList
     , reverseProxySsl
     , setDir
     , TLSConfig
     , TLSConfigNoDir
     ) where
 
-import Keter.Prelude ((++))
 import Prelude hiding ((++), FilePath)
 import Data.Conduit
 import Data.Conduit.Network
@@ -18,11 +16,8 @@ import Data.ByteString (ByteString)
 import Keter.PortManager (PortEntry (..))
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
-import Blaze.ByteString.Builder (fromByteString, toLazyByteString)
-import Data.Monoid (mconcat)
 import Keter.SSL
 import Network.HTTP.ReverseProxy (rawProxyTo, ProxyDest (ProxyDest), waiToRaw)
-import Control.Applicative ((<$>))
 import Network.Wai.Application.Static (defaultFileServerSettings, staticApp)
 import qualified Network.Wai as Wai
 import Network.HTTP.Types (status301)
@@ -30,24 +25,21 @@ import Network.HTTP.Types (status301)
 -- | Mapping from virtual hostname to port number.
 type PortLookup = ByteString -> IO (Maybe PortEntry)
 
-type HostList = IO [ByteString]
+reverseProxy :: ServerSettings IO -> PortLookup -> IO ()
+reverseProxy settings = runTCPServer settings . withClient
 
-reverseProxy :: ServerSettings IO -> PortLookup -> HostList -> IO ()
-reverseProxy settings x = runTCPServer settings . withClient x
-
-reverseProxySsl :: TLSConfig -> PortLookup -> HostList -> IO ()
-reverseProxySsl settings x = runTCPServerTLS settings . withClient x
+reverseProxySsl :: TLSConfig -> PortLookup -> IO ()
+reverseProxySsl settings = runTCPServerTLS settings . withClient
 
 withClient :: PortLookup
-           -> HostList
            -> Application IO
-withClient portLookup hostList =
+withClient portLookup =
     rawProxyTo getDest
   where
     getDest headers = do
         mport <- maybe (return Nothing) portLookup $ lookup "host" headers
         case mport of
-            Nothing -> Left . srcToApp . toResponse <$> hostList
+            Nothing -> return $ Left $ srcToApp $ toResponse []
             Just (PEPort port) -> return $ Right $ ProxyDest "127.0.0.1" port
             Just (PEStatic root) -> return $ Left $ waiToRaw $ staticApp $ defaultFileServerSettings root
             Just (PERedirect host) -> return $ Left $ waiToRaw $ redirectApp host
@@ -70,9 +62,4 @@ srcToApp src appdata = src $$ appSink appdata
 
 toResponse :: Monad m => [ByteString] -> Source m ByteString
 toResponse hosts =
-    mapM_ yield $ L.toChunks $ toLazyByteString $ front ++ mconcat (map go hosts) ++ end
-  where
-    front = fromByteString "HTTP/1.1 200 OK\r\nContent-Type: text/html; charset=utf-8\r\n\r\n<html><head><title>Welcome to Keter</title></head><body><h1>Welcome to Keter</h1><p>You may access the following sites:</p><ul>"
-    end = fromByteString "</ul></body></html>"
-    go host = fromByteString "<li><a href=\"http://" ++ fromByteString host ++ fromByteString "/\">" ++
-              fromByteString host ++ fromByteString "</a></li>"
+    yield "HTTP/1.1 200 OK\r\nContent-Type: text/html; charset=utf-8\r\n\r\n<html><head><title>Welcome to Keter</title></head><body><h1>Welcome to Keter</h1><p>The hostname you have provided is not recognized.</p></body></html>"