@@ -9,10 +9,13 @@ import Data.Text as T
99import Data.Text (Text)
1010import Data.Text.Encoding (decodeUtf8, encodeUtf8)
1111import Network.HTTP.Client (defaultManagerSettings, httpLbs,
12− method, newManager, parseUrl)
12+ method, newManager, parseUrl,
13+ managerRawConnection)
1314import Network.HTTP.Types (Query, encodePath,
1415 encodePathSegments)
15−
16+import Network.HTTP.Client.Internal (makeConnection)
17+import qualified Network.Socket as S
18+import qualified Network.Socket.ByteString as SBS
1619import Docker.Types
1720
1821-- The reason we return Maybe Request is because the parseURL function
@@ -35,12 +38,33 @@ defaultHttpHandler request = do
3538 response <- httpLbs request manager
3639 return response
3740
41+-- | Connect to a unix domain socket (the default docker socket is
42+-- at \/var\/run\/docker.sock)
43+--
44+-- Docker seems to ignore the hostname in requests sent over unix domain
45+-- sockets (and the port obviously doesn't matter either)
46+unixHttpHandler :: FilePath -- ^ The socket to connect to
47+ -> HttpHandler IO
48+unixHttpHandler fp request= do
49+ let mSettings = defaultManagerSettings
50+ { managerRawConnection = return $ openUnixSocket fp}
51+ manager <- newManager mSettings
52+ httpLbs request manager
53+ where
54+ openUnixSocket filePath _ _ _ = do
55+ s <- S.socket S.AF_UNIX S.Stream S.defaultProtocol
56+ S.connect s (S.SockAddrUnix filePath)
57+ makeConnection (SBS.recv s 8096)
58+ (SBS.sendAll s)
59+ (S.sClose s)
60+
3861encodeURL :: [Text] -> Text
3962encodeURL ps = decodeUtf8 $ toByteString $ encodePathSegments ps
4063
4164encodeURLWithQuery :: [Text] -> Query -> Text
4265encodeURLWithQuery ps q = decodeUtf8 $ toByteString $ encodePath ps q
4366
67+encodeQ :: String -> ByteString
4468encodeQ = encodeUtf8 . T.pack
4569
4670getEndpoint :: Endpoint -> Text
@@ -74,4 +98,3 @@ getEndpoint (ContainerLogsEndpoint cid (LogOpts follow stdout stderr since times
7498getEndpoint (DeleteContainerEndpoint (DeleteOpts removeVolumes force) cid) =
7599 encodeURLWithQuery ["containers", cid] query
76100 where query = [("v", Just (encodeQ $ show removeVolumes)), ("force", Just (encodeQ $ show force))]
77−