Rework parameter parsing

4 files changed, 75 insertions, 51 deletions

diff --git a/gopher-proxy.cabal b/gopher-proxy.cabal
index 07d81f8..66bcf65 100644
--- a/gopher-proxy.cabal
+++ b/gopher-proxy.cabal
@@ -29,7 +29,6 @@ executable gopher-proxy
                      , attoparsec
                      , errors
                      , mime-types
-                     , optparse-generic
                      , optparse-applicative
   hs-source-dirs:      src
   default-language:    Haskell2010
diff --git a/src/GopherProxy/Config.hs b/src/GopherProxy/Config.hs
deleted file mode 100644
index ec0b44e..0000000
--- a/src/GopherProxy/Config.hs
+++ /dev/null
@@ -1,37 +0,0 @@
-{-# LANGUAGE DeriveGeneric     #-}
-{-# LANGUAGE OverloadedStrings #-}
-module GopherProxy.Config
-  ( Config (..)
-  , dCssUrl
-  , dBaseUrl
-  ) where
-
-import qualified Data.ByteString as BS
-import Data.Maybe (fromMaybe)
-import Network.Socket (HostName (), PortNumber ())
-import Options.Applicative.Types
-import Options.Generic
-
-data Config
-  = Config
-    { hostname     :: HostName
-    , port         :: PortNumber
-    , httpPort     :: Int
-    , cssPath      :: FilePath
-    , cssUrl       :: Maybe BS.ByteString
-    , baseUrl      :: Maybe Text
-    } deriving (Generic, Show)
-
-instance ParseRecord PortNumber where
-  parseRecord = fmap getOnly parseRecord
-
-instance ParseFields PortNumber where
-  parseFields a b = fmap fromIntegral (parseFields a b :: Parser Integer)
-
-instance ParseRecord Config
-
-dCssUrl :: Config -> BS.ByteString
-dCssUrl = fromMaybe "/gopher-proxy.css" . cssUrl
-
-dBaseUrl :: Config -> Text
-dBaseUrl = fromMaybe "/" . baseUrl
diff --git a/src/GopherProxy/Params.hs b/src/GopherProxy/Params.hs
new file mode 100644
index 0000000..d29fe41
--- /dev/null
+++ b/src/GopherProxy/Params.hs
@@ -0,0 +1,60 @@
+{-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE OverloadedStrings #-}
+module GopherProxy.Params
+  ( Params (..)
+  , params
+  , helpfulParams
+  ) where
+
+import qualified Data.ByteString as BS
+import Data.Maybe (fromMaybe)
+import Data.Text (Text ())
+import Network.Socket (HostName (), PortNumber ())
+import Options.Applicative
+
+data Params
+  = Params
+    { hostname     :: HostName
+    , port         :: PortNumber
+    , httpPort     :: Int
+    , cssPath      :: FilePath
+    , cssUrl       :: BS.ByteString
+    , baseUrl      :: Text
+    , listenPublic :: Bool
+    }
+
+helpfulParams :: ParserInfo Params
+helpfulParams = info (helper <*> params) fullDesc
+
+params :: Parser Params
+params = Params
+  <$> strOption
+    (long "host"
+    <> metavar "HOSTNAME"
+    <> help "hostname of the target gopher server")
+  <*> optionalWithDefault 70 (option auto
+    (long "port"
+    <> metavar "PORT"
+    <> help "port of the target gopher server"))
+  <*> option auto
+    (long "http-port"
+    <> metavar "PORT"
+    <> help "port gopher-proxy should listen on")
+  <*> strOption
+    (long "css-path"
+    <> metavar "PATH"
+    <> help "path of the css to be used")
+  <*> optionalWithDefault "/gopher-proxy.css" (option auto
+    (long "css-url"
+    <> metavar "PATH"
+    <> help "absolute location of the css on the web server, defaults to \"/gopher-proxy.css\""))
+  <*> optionalWithDefault "/" (option auto
+    (long "base-url"
+    <> metavar "PATH"
+    <> help "base url where gopher-proxy is running, defaults to \"/\""))
+  <*> switch
+    (long "listen-public"
+    <> help "wether gopher-proxy should accept connection on public IP addresses.")
+
+optionalWithDefault :: a -> Parser a -> Parser a
+optionalWithDefault def p = fromMaybe def <$> optional p
diff --git a/src/Main.hs b/src/Main.hs
index 6b0eef1..4b1320b 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -7,7 +7,7 @@
 
 import GopherProxy.Types
 import GopherProxy.Protocol
-import GopherProxy.Config
+import GopherProxy.Params
 
 import Prelude hiding (takeWhile)
 import Control.Exception
@@ -29,23 +29,23 @@ import Network.Socket.ByteString
 import Network.Wai
 import Network.Wai.Handler.Warp
 import Lucid
-import Options.Generic
+import qualified Options.Applicative as O
 
-gopherProxy :: Config -> Application
+gopherProxy :: Params -> Application
 gopherProxy cfg r resp
   | requestMethod r == "GET" &&
-    rawPathInfo r == dCssUrl cfg = cssResponse cfg r resp `catch` \(e::IOException) ->
+    rawPathInfo r == cssUrl cfg = cssResponse cfg r resp `catch` \(e::IOException) ->
       internalErrorResponse "An IO error occured while retrieving the css." r resp
   | requestMethod r == "GET" = gopherResponse cfg r resp `catch` \(e::IOException) ->
       internalErrorResponse (T.pack "An IO error occured while contacting the gopher server.") r resp
   | otherwise = badRequestResponse cfg r resp
 
-cssResponse :: Config -> Application
+cssResponse :: Params -> Application
 cssResponse cfg _ respond = do
   css <- B.readFile . cssPath $ cfg
   respond $ responseLBS status200 [("Content-type", "text/css")] css
 
-gopherResponse :: Config -> Application
+gopherResponse :: Params -> Application
 gopherResponse cfg r respond = do
   (resp, mime) <- (flip fmap)
     (makeGopherRequest (hostname cfg) (port cfg) (B.fromStrict (rawPathInfo r))) $
@@ -63,7 +63,7 @@ gopherResponse cfg r respond = do
           ("text", _)      -> ([("Content-type", "text/html")], renderBS (gResponseToHtml cfg resp))
           _                -> ([("Content-type", mime)], b)
 
-badRequestResponse :: Config -> Application
+badRequestResponse :: Params -> Application
 badRequestResponse cfg _ respond = respond $ responseLBS badRequest400
   [("Content-type", "text/plain")] "gopher-proxy did not understand your request"
 
@@ -102,18 +102,18 @@ prependBaseUrl base path
   | otherwise = base <> "/" <> path
 
 -- we generally assume that everything is utf-8 encoded
-gResponseToHtml :: Config -> GopherResponse -> Html ()
+gResponseToHtml :: Params -> GopherResponse -> Html ()
 gResponseToHtml cfg res
   = doctype_ <> html_
       (head_ (meta_ [charset_ "utf-8"]
              <> title_ "gopher-proxy"
-             <> link_ [rel_ "stylesheet", type_ "text/css", href_ . decodeUtf8 . dCssUrl $ cfg])
+             <> link_ [rel_ "stylesheet", type_ "text/css", href_ . decodeUtf8 . cssUrl $ cfg])
       <> body_ bodyContent)
   where bodyContent = case res of
                         FileResponse bytes -> pre_ (toHtml bytes)
                         MenuResponse items -> ul_ $ foldl (itemChain cfg) mempty items
 
-itemChain :: Config -> Html () -> MenuItem -> Html ()
+itemChain :: Params -> Html () -> MenuItem -> Html ()
 itemChain cfg acc (MenuItem typec desc path' host' port')
   = acc <> li_ itemHtml
     where path = decodeUtf8 . B.toStrict $ path'
@@ -124,10 +124,12 @@ itemChain cfg acc (MenuItem typec desc path' host' port')
           url = if "URL:" `T.isPrefixOf` path
                   then T.drop 4 path
                   else if host' == hostname cfg && port' == port cfg
-                    then prependBaseUrl (dBaseUrl cfg) path
+                    then prependBaseUrl (baseUrl cfg) path
                     else prependBaseUrl ("gopher://" <> (T.pack host') <> ":" <> (T.pack (show port'))) path
 
 main :: IO ()
 main = do
-  config <- getRecord "gopher-proxy"
-  run (httpPort config) (gopherProxy config)
+  params <- O.execParser helpfulParams
+  let preference = if listenPublic params then "*" else "127.0.0.1"
+      settings = setPort (httpPort params) . setHost preference $ defaultSettings
+  runSettings settings (gopherProxy params)