From f8f3cdc129b446ed3807ac22295b6001f51a1088 Mon Sep 17 00:00:00 2001 From: Colin King Date: Thu, 8 Jan 2015 19:51:12 -0600 Subject: [PATCH 1/4] Add scottySocketT and scottySocket, exposing Warp Unix socket support --- Web/Scotty.hs | 10 +++++++++- Web/Scotty/Trans.hs | 20 ++++++++++++++++++-- scotty.cabal | 1 + 3 files changed, 28 insertions(+), 3 deletions(-) diff --git a/Web/Scotty.hs b/Web/Scotty.hs index 7b3a464f..ecba305b 100644 --- a/Web/Scotty.hs +++ b/Web/Scotty.hs @@ -7,7 +7,7 @@ -- the comments on each of these functions for more information. module Web.Scotty ( -- * scotty-to-WAI - scotty, scottyApp, scottyOpts, Options(..) + scotty, scottyApp, scottyOpts, scottySocket, Options(..) -- * Defining Middleware and Routes -- -- | 'Middleware' and routes are run in the order in which they @@ -41,6 +41,7 @@ import qualified Data.ByteString as BS import Data.ByteString.Lazy.Char8 (ByteString) import Data.Text.Lazy (Text) +import Network (Socket) import Network.HTTP.Types (Status, StdMethod) import Network.Wai (Application, Middleware, Request, StreamingBody) import Network.Wai.Handler.Warp (Port) @@ -58,6 +59,13 @@ scotty p = Trans.scottyT p id id scottyOpts :: Options -> ScottyM () -> IO () scottyOpts opts = Trans.scottyOptsT opts id id +-- | Run a scotty application using the warp server, passing extra options, +-- and listening on the provided socket. This allows the user to provide, for +-- example, a Unix named socket, which can be used when reverse HTTP proxying +-- into your application. +scottySocket :: Options -> Socket -> ScottyM () -> IO () +scottySocket opts sock = Trans.scottySocketT opts sock id id + -- | Turn a scotty application into a WAI 'Application', which can be -- run with any WAI handler. scottyApp :: ScottyM () -> IO Application diff --git a/Web/Scotty/Trans.hs b/Web/Scotty/Trans.hs index 3f328e81..62d3c0ab 100644 --- a/Web/Scotty/Trans.hs +++ b/Web/Scotty/Trans.hs @@ -11,7 +11,7 @@ -- the comments on each of these functions for more information. module Web.Scotty.Trans ( -- * scotty-to-WAI - scottyT, scottyAppT, scottyOptsT, Options(..) + scottyT, scottyAppT, scottyOptsT, scottySocketT, Options(..) -- * Defining Middleware and Routes -- -- | 'Middleware' and routes are run in the order in which they @@ -47,9 +47,10 @@ import Control.Monad.IO.Class import Data.Default (def) +import Network (Socket) import Network.HTTP.Types (status404, status500) import Network.Wai -import Network.Wai.Handler.Warp (Port, runSettings, setPort, getPort) +import Network.Wai.Handler.Warp (Port, runSettings, runSettingsSocket, setPort, getPort) import Web.Scotty.Action import Web.Scotty.Route @@ -79,6 +80,21 @@ scottyOptsT opts runM runActionToIO s = do liftIO $ putStrLn $ "Setting phasers to stun... (port " ++ show (getPort (settings opts)) ++ ") (ctrl-c to quit)" liftIO . runSettings (settings opts) =<< scottyAppT runM runActionToIO s +-- | Run a scotty application using the warp server, passing extra options, and +-- listening on the provided socket. +-- NB: scottySocket opts sock === scottySocketT opts sock id id +scottySocketT :: (Monad m, MonadIO n) + => Options + -> Socket + -> (forall a. m a -> n a) + -> (m Response -> IO Response) + -> ScottyT e m () + -> n () +scottySocketT opts sock runM runActionToIO s = do + when (verbose opts > 0) $ + liftIO $ putStrLn $ "Setting phasers to stun... (port " ++ show (getPort (settings opts)) ++ ") (ctrl-c to quit)" + liftIO . runSettingsSocket (settings opts) sock =<< scottyAppT runM runActionToIO s + -- | Turn a scotty application into a WAI 'Application', which can be -- run with any WAI handler. -- NB: scottyApp === scottyAppT id id diff --git a/scotty.cabal b/scotty.cabal index 3e991389..67cab3bc 100644 --- a/scotty.cabal +++ b/scotty.cabal @@ -77,6 +77,7 @@ Library http-types >= 0.8.2 && < 0.9, mtl >= 2.1.2 && < 2.3, monad-control >= 1.0.0.0 && < 1.1, + network >= 2.6.0.2 && < 2.7.0.0, regex-compat >= 0.95.1 && < 0.96, text >= 0.11.3.1 && < 1.3, transformers >= 0.3.0.0 && < 0.5, From c5d7a937f31d41373312f3379ee792c4c8206141 Mon Sep 17 00:00:00 2001 From: Colin King Date: Thu, 8 Jan 2015 21:07:14 -0600 Subject: [PATCH 2/4] Add socket description for scottySocket's verbose output --- Web/Scotty/Trans.hs | 6 ++++-- Web/Scotty/Util.hs | 11 +++++++++++ 2 files changed, 15 insertions(+), 2 deletions(-) diff --git a/Web/Scotty/Trans.hs b/Web/Scotty/Trans.hs index 62d3c0ab..a7cca053 100644 --- a/Web/Scotty/Trans.hs +++ b/Web/Scotty/Trans.hs @@ -55,6 +55,7 @@ import Network.Wai.Handler.Warp (Port, runSettings, runSettingsSocket, setPort, import Web.Scotty.Action import Web.Scotty.Route import Web.Scotty.Internal.Types hiding (Application, Middleware) +import Web.Scotty.Util (socketDescription) import qualified Web.Scotty.Internal.Types as Scotty -- | Run a scotty application using the warp server. @@ -91,8 +92,9 @@ scottySocketT :: (Monad m, MonadIO n) -> ScottyT e m () -> n () scottySocketT opts sock runM runActionToIO s = do - when (verbose opts > 0) $ - liftIO $ putStrLn $ "Setting phasers to stun... (port " ++ show (getPort (settings opts)) ++ ") (ctrl-c to quit)" + when (verbose opts > 0) $ do + d <- liftIO $ socketDescription sock + liftIO $ putStrLn $ "Setting phasers to stun... (" ++ d ++ ") (ctrl-c to quit)" liftIO . runSettingsSocket (settings opts) sock =<< scottyAppT runM runActionToIO s -- | Turn a scotty application into a WAI 'Application', which can be diff --git a/Web/Scotty/Util.hs b/Web/Scotty/Util.hs index 58440cb7..ca32765b 100644 --- a/Web/Scotty/Util.hs +++ b/Web/Scotty/Util.hs @@ -8,8 +8,11 @@ module Web.Scotty.Util , replace , add , addIfNotPresent + , socketDescription ) where +import Network (Socket, PortID(..), socketPort) +import Network.Socket (PortNumber(..)) import Network.Wai import Network.HTTP.Types @@ -59,3 +62,11 @@ addIfNotPresent k v = go go l@((x,y):r) | x == k = l | otherwise = (x,y) : go r + +-- Assemble a description from the Socket's PortID. +socketDescription :: Socket -> IO String +socketDescription = fmap d . socketPort + where d p = case p of + Service s -> "service " ++ s + PortNumber (PortNum n) -> "port " ++ show n + UnixSocket u -> "unix socket " ++ show u From c05edf4b643f47bfd048efcfaab6943276ce2707 Mon Sep 17 00:00:00 2001 From: Colin King Date: Thu, 8 Jan 2015 21:15:54 -0600 Subject: [PATCH 3/4] Remove unnecessary show --- Web/Scotty/Util.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Web/Scotty/Util.hs b/Web/Scotty/Util.hs index ca32765b..7bb81a35 100644 --- a/Web/Scotty/Util.hs +++ b/Web/Scotty/Util.hs @@ -69,4 +69,4 @@ socketDescription = fmap d . socketPort where d p = case p of Service s -> "service " ++ s PortNumber (PortNum n) -> "port " ++ show n - UnixSocket u -> "unix socket " ++ show u + UnixSocket u -> "unix socket " ++ u From 5bb8be42ec66bb19886a68327b81d56376253c81 Mon Sep 17 00:00:00 2001 From: Colin King Date: Sun, 11 Jan 2015 17:48:15 -0600 Subject: [PATCH 4/4] Add tests for scottySocket --- Web/Scotty/Util.hs | 3 +++ scotty.cabal | 21 ++++++++++++--------- test/Web/ScottySpec.hs | 36 +++++++++++++++++++++++++++++++++++- 3 files changed, 50 insertions(+), 10 deletions(-) diff --git a/Web/Scotty/Util.hs b/Web/Scotty/Util.hs index 7bb81a35..ee75aeab 100644 --- a/Web/Scotty/Util.hs +++ b/Web/Scotty/Util.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Web.Scotty.Util ( lazyTextToStrictByteString , strictByteStringToLazyText @@ -69,4 +70,6 @@ socketDescription = fmap d . socketPort where d p = case p of Service s -> "service " ++ s PortNumber (PortNum n) -> "port " ++ show n +#ifndef WINDOWS UnixSocket u -> "unix socket " ++ u +#endif diff --git a/scotty.cabal b/scotty.cabal index 67cab3bc..b28cd805 100644 --- a/scotty.cabal +++ b/scotty.cabal @@ -77,7 +77,7 @@ Library http-types >= 0.8.2 && < 0.9, mtl >= 2.1.2 && < 2.3, monad-control >= 1.0.0.0 && < 1.1, - network >= 2.6.0.2 && < 2.7.0.0, + network >= 2.6.0.2 && < 2.7, regex-compat >= 0.95.1 && < 0.96, text >= 0.11.3.1 && < 1.3, transformers >= 0.3.0.0 && < 0.5, @@ -93,16 +93,19 @@ test-suite spec type: exitcode-stdio-1.0 default-language: Haskell2010 hs-source-dirs: test - build-depends: base, - bytestring, - text, - http-types, - lifted-base, - wai, + build-depends: async, + base, + data-default, + directory, hspec == 2.*, hspec-wai >= 0.5, - scotty - GHC-options: -Wall -fno-warn-orphans + http-types, + lifted-base, + network, + scotty, + text, + wai + GHC-options: -Wall -threaded -fno-warn-orphans source-repository head type: git diff --git a/test/Web/ScottySpec.hs b/test/Web/ScottySpec.hs index f6010905..72b247d4 100644 --- a/test/Web/ScottySpec.hs +++ b/test/Web/ScottySpec.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, CPP #-} module Web.ScottySpec (main, spec) where import Test.Hspec @@ -15,6 +15,14 @@ import qualified Control.Exception as E import Web.Scotty as Scotty hiding (get, post, put, patch, delete, request) import qualified Web.Scotty as Scotty +#ifndef WINDOWS +import Control.Concurrent.Async (withAsync) +import Data.Default (def) +import Network (listenOn, PortID(..)) +import Network.Socket +import System.Directory (removeFile) +#endif + main :: IO () main = hspec spec @@ -127,3 +135,29 @@ spec = do withApp (Scotty.get "/scotty" $ setHeader "Content-Type" "text/somethingweird" >> json (Just (5::Int))) $ do it "doesn't override a previously set Content-Type header" $ do get "/scotty" `shouldRespondWith` 200 {matchHeaders = ["Content-Type" <:> "text/somethingweird"]} + +-- Unix sockets not available on Windows +#ifndef WINDOWS + describe "scottySocket" . + it "works with a unix socket" . + withServer (Scotty.get "/scotty" $ html "") . + E.bracket (socket AF_UNIX Stream 0) close $ \sock -> do + connect sock $ SockAddrUnix socketPath + _ <- send sock "GET /scotty HTTP/1.1\r\n\n" + r1 <- recv sock 1024 + _ <- send sock "GET /four-oh-four HTTP/1.1\r\n\n" + r2 <- recv sock 1024 + (take (length ok) r1, take (length no) r2) `shouldBe` (ok, no) + where ok = "HTTP/1.1 200 OK" + no = "HTTP/1.1 404 Not Found" + +socketPath :: FilePath +socketPath = "/tmp/scotty-test.socket" + +withServer :: ScottyM () -> IO a -> IO a +withServer actions inner = E.bracket + (listenOn $ UnixSocket socketPath) + (\sock -> close sock >> removeFile socketPath) + (\sock -> withAsync (Scotty.scottySocket def sock actions) $ const inner) +#endif +