Skip to content

Instantly share code, notes, and snippets.

@phadej
Created July 6, 2016 23:31
Show Gist options
  • Star 3 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save phadej/b78d95b4107e4828119f33cebf38912f to your computer and use it in GitHub Desktop.
Save phadej/b78d95b4107e4828119f33cebf38912f to your computer and use it in GitHub Desktop.
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