{-# LANGUAGE OverloadedStrings #-}

-- | HTTP Connection managers and utilities for connecting to the Docker Engine API
module Docker.API.Client.Internal.Connection where

import Docker.API.Client.Internal.Types (OS (..))
import Network.HTTP.Client
import Network.HTTP.Client.Internal (makeConnection)
import qualified Network.Socket as S
import qualified Network.Socket.ByteString as SBS
import System.IO (FilePath)

-- | Default docker socket path on unix systems
defaultDockerUnixSocket :: FilePath
defaultDockerUnixSocket :: FilePath
defaultDockerUnixSocket = FilePath
"/var/run/docker.sock"

-- | Creates a new HTTP connection manager for the default docker daemon address
-- on your system.
newDefaultDockerManager :: OS -> IO Manager
-- TODO: default uri and manager for windows (which uses tcp instead of a socket)
newDefaultDockerManager :: OS -> IO Manager
newDefaultDockerManager (OS FilePath
"mingw32") = IO Manager
forall a. HasCallStack => a
undefined
newDefaultDockerManager OS
_ = FilePath -> IO Manager
newUnixDomainSocketManager FilePath
defaultDockerUnixSocket

-- | Creates a new http connection manager from a file path to a unix socket
newUnixDomainSocketManager :: FilePath -> IO Manager
newUnixDomainSocketManager :: FilePath -> IO Manager
newUnixDomainSocketManager FilePath
path = do
  -- Stolen from: https://kseo.github.io/posts/2017-01-23-custom-connection-manager-for-http-client.html
  let mSettings :: ManagerSettings
mSettings = ManagerSettings
defaultManagerSettings {managerRawConnection :: IO (Maybe HostAddress -> FilePath -> Int -> IO Connection)
managerRawConnection = (Maybe HostAddress -> FilePath -> Int -> IO Connection)
-> IO (Maybe HostAddress -> FilePath -> Int -> IO Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe HostAddress -> FilePath -> Int -> IO Connection)
 -> IO (Maybe HostAddress -> FilePath -> Int -> IO Connection))
-> (Maybe HostAddress -> FilePath -> Int -> IO Connection)
-> IO (Maybe HostAddress -> FilePath -> Int -> IO Connection)
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe HostAddress -> FilePath -> Int -> IO Connection
forall p p p. FilePath -> p -> p -> p -> IO Connection
openUnixSocket FilePath
path}
  ManagerSettings -> IO Manager
newManager ManagerSettings
mSettings
  where
    openUnixSocket :: FilePath -> p -> p -> p -> IO Connection
openUnixSocket FilePath
filePath p
_ p
_ p
_ = do
      Socket
s <- Family -> SocketType -> ProtocolNumber -> IO Socket
S.socket Family
S.AF_UNIX SocketType
S.Stream ProtocolNumber
S.defaultProtocol
      Socket -> SockAddr -> IO ()
S.connect Socket
s (FilePath -> SockAddr
S.SockAddrUnix FilePath
filePath)
      IO ByteString -> (ByteString -> IO ()) -> IO () -> IO Connection
makeConnection
        (Socket -> Int -> IO ByteString
SBS.recv Socket
s Int
8096)
        (Socket -> ByteString -> IO ()
SBS.sendAll Socket
s)
        (Socket -> IO ()
S.close Socket
s)