Warp + http-client usage over UNIX-socket. Works with packages from LTS-6.0
{-# LANGUAGE OverloadedStrings #-} | |
import Network.HTTP.Client | |
import Network.HTTP.Client.Internal (Connection, openSocketConnection, makeConnection) | |
import Network.Socket.ByteString (sendAll, recv) | |
import qualified Control.Exception as E | |
import qualified Network.Socket as NS | |
main :: IO () | |
main = do | |
mgr <- newManager defaultManagerSettings { | |
managerRawConnection = createUnixConnection | |
} | |
req <- parseUrl "http://localhost/whatever" | |
res <- httpLbs req mgr | |
print (responseBody res) | |
createUnixConnection :: IO (Maybe NS.HostAddress -> String -> Int -> IO Connection) | |
createUnixConnection = return $ \_ _ _ -> openUnixConnection "warp.sock" | |
openUnixConnection :: String -> IO Connection | |
openUnixConnection addr = E.bracketOnError | |
(NS.socket NS.AF_UNIX NS.Stream NS.defaultProtocol) | |
(NS.close) | |
$ \sock -> do | |
NS.connect sock sockAddr | |
socketConnection sock chunksize | |
where | |
sockAddr = NS.SockAddrUnix addr | |
chunksize = 8192 | |
------------------------------------------------------------------------------- | |
-- Copied from http-client | |
------------------------------------------------------------------------------- | |
socketConnection :: NS.Socket -> Int -> IO Connection | |
socketConnection socket chunksize = makeConnection | |
(recv socket chunksize) | |
(sendAll socket) | |
(NS.close socket) |
-- Copied and corrected from: | |
-- http://stackoverflow.com/questions/22621623/warp-binding-to-unix-domain-sockets#22621624 | |
{-# LANGUAGE OverloadedStrings #-} | |
import Network.Wai (Application, responseLBS) | |
import Network.Wai.Handler.Warp | |
import Network.Socket | |
import Network.HTTP.Types (status200) | |
import Network.HTTP.Types.Header (hContentType) | |
main = do | |
let port = 3000 | |
-- Open the socket | |
sock <- socket AF_UNIX Stream 0 | |
bind sock $ SockAddrUnix "warp.sock" | |
listen sock maxListenQueue | |
-- Run the server | |
let settings = setPort port defaultSettings | |
runSettingsSocket settings sock app | |
-- Cleanup: Close socket | |
close sock | |
app :: Application | |
app req f = f $ | |
responseLBS status200 [(hContentType, "text/plain")] "Hello world!" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment