{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, LambdaCase, PatternGuards #-}
module Network.HTTP.Client.Restricted (
Restriction,
checkAddressRestriction,
addressRestriction,
mkRestrictedManagerSettings,
ConnectionRestricted(..),
connectionRestricted,
ProxyRestricted(..),
IPAddrString,
) where
import Network.HTTP.Client
import Network.HTTP.Client.Internal (ManagerSettings(..), Connection, runProxyOverride)
import Network.HTTP.Client.TLS (mkManagerSettingsContext)
import Network.Socket
import Network.BSD (getProtocolNumber)
import Control.Exception
import qualified Network.Connection as NC
import qualified Data.ByteString.UTF8 as BU
import Data.Maybe
import Data.Default
import Data.Typeable
import qualified Data.Semigroup as Sem
import Data.Monoid
import Control.Applicative
import Prelude
data Restriction = Restriction
{ Restriction -> AddrInfo -> Maybe ConnectionRestricted
checkAddressRestriction :: AddrInfo -> Maybe ConnectionRestricted
}
addressRestriction :: (AddrInfo -> Maybe ConnectionRestricted) -> Restriction
addressRestriction :: (AddrInfo -> Maybe ConnectionRestricted) -> Restriction
addressRestriction AddrInfo -> Maybe ConnectionRestricted
f = Restriction
forall a. Monoid a => a
mempty { checkAddressRestriction :: AddrInfo -> Maybe ConnectionRestricted
checkAddressRestriction = AddrInfo -> Maybe ConnectionRestricted
f }
appendRestrictions :: Restriction -> Restriction -> Restriction
appendRestrictions :: Restriction -> Restriction -> Restriction
appendRestrictions Restriction
a Restriction
b = Restriction :: (AddrInfo -> Maybe ConnectionRestricted) -> Restriction
Restriction
{ checkAddressRestriction :: AddrInfo -> Maybe ConnectionRestricted
checkAddressRestriction = \AddrInfo
addr ->
Restriction -> AddrInfo -> Maybe ConnectionRestricted
checkAddressRestriction Restriction
a AddrInfo
addr Maybe ConnectionRestricted
-> Maybe ConnectionRestricted -> Maybe ConnectionRestricted
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Restriction -> AddrInfo -> Maybe ConnectionRestricted
checkAddressRestriction Restriction
b AddrInfo
addr
}
instance Monoid Restriction where
mempty :: Restriction
mempty = Restriction :: (AddrInfo -> Maybe ConnectionRestricted) -> Restriction
Restriction
{ checkAddressRestriction :: AddrInfo -> Maybe ConnectionRestricted
checkAddressRestriction = \AddrInfo
_ -> Maybe ConnectionRestricted
forall a. Maybe a
Nothing
}
instance Sem.Semigroup Restriction where
<> :: Restriction -> Restriction -> Restriction
(<>) = Restriction -> Restriction -> Restriction
appendRestrictions
data ConnectionRestricted = ConnectionRestricted String
deriving (Int -> ConnectionRestricted -> ShowS
[ConnectionRestricted] -> ShowS
ConnectionRestricted -> String
(Int -> ConnectionRestricted -> ShowS)
-> (ConnectionRestricted -> String)
-> ([ConnectionRestricted] -> ShowS)
-> Show ConnectionRestricted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionRestricted] -> ShowS
$cshowList :: [ConnectionRestricted] -> ShowS
show :: ConnectionRestricted -> String
$cshow :: ConnectionRestricted -> String
showsPrec :: Int -> ConnectionRestricted -> ShowS
$cshowsPrec :: Int -> ConnectionRestricted -> ShowS
Show, Typeable)
instance Exception ConnectionRestricted
type IPAddrString = String
connectionRestricted :: (IPAddrString -> String) -> AddrInfo -> ConnectionRestricted
connectionRestricted :: ShowS -> AddrInfo -> ConnectionRestricted
connectionRestricted ShowS
mkmessage =
String -> ConnectionRestricted
ConnectionRestricted (String -> ConnectionRestricted)
-> (AddrInfo -> String) -> AddrInfo -> ConnectionRestricted
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
mkmessage ShowS -> (AddrInfo -> String) -> AddrInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SockAddr -> String
showSockAddress (SockAddr -> String)
-> (AddrInfo -> SockAddr) -> AddrInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddrInfo -> SockAddr
addrAddress
data ProxyRestricted = ProxyRestricted
deriving (Int -> ProxyRestricted -> ShowS
[ProxyRestricted] -> ShowS
ProxyRestricted -> String
(Int -> ProxyRestricted -> ShowS)
-> (ProxyRestricted -> String)
-> ([ProxyRestricted] -> ShowS)
-> Show ProxyRestricted
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ProxyRestricted] -> ShowS
$cshowList :: [ProxyRestricted] -> ShowS
show :: ProxyRestricted -> String
$cshow :: ProxyRestricted -> String
showsPrec :: Int -> ProxyRestricted -> ShowS
$cshowsPrec :: Int -> ProxyRestricted -> ShowS
Show)
restrictManagerSettings
:: Maybe NC.ConnectionContext
-> Maybe NC.TLSSettings
-> Restriction
-> ManagerSettings
-> IO (ManagerSettings, Maybe ProxyRestricted)
restrictManagerSettings :: Maybe ConnectionContext
-> Maybe TLSSettings
-> Restriction
-> ManagerSettings
-> IO (ManagerSettings, Maybe ProxyRestricted)
restrictManagerSettings Maybe ConnectionContext
mcontext Maybe TLSSettings
mtls Restriction
cfg ManagerSettings
base = Restriction
-> ManagerSettings -> IO (ManagerSettings, Maybe ProxyRestricted)
restrictProxy Restriction
cfg (ManagerSettings -> IO (ManagerSettings, Maybe ProxyRestricted))
-> ManagerSettings -> IO (ManagerSettings, Maybe ProxyRestricted)
forall a b. (a -> b) -> a -> b
$ ManagerSettings
base
{ managerRawConnection :: IO (Maybe HostAddress -> String -> Int -> IO Connection)
managerRawConnection = Restriction
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
restrictedRawConnection Restriction
cfg
, managerTlsConnection :: IO (Maybe HostAddress -> String -> Int -> IO Connection)
managerTlsConnection = Maybe ConnectionContext
-> Maybe TLSSettings
-> Restriction
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
restrictedTlsConnection Maybe ConnectionContext
mcontext Maybe TLSSettings
mtls Restriction
cfg
, managerWrapException :: forall a. Request -> IO a -> IO a
managerWrapException = ManagerSettings -> Request -> IO a -> IO a
forall a. ManagerSettings -> Request -> IO a -> IO a
wrapOurExceptions ManagerSettings
base
}
mkRestrictedManagerSettings
:: Restriction
-> Maybe NC.ConnectionContext
-> Maybe NC.TLSSettings
-> IO (ManagerSettings, Maybe ProxyRestricted)
mkRestrictedManagerSettings :: Restriction
-> Maybe ConnectionContext
-> Maybe TLSSettings
-> IO (ManagerSettings, Maybe ProxyRestricted)
mkRestrictedManagerSettings Restriction
cfg Maybe ConnectionContext
mcontext Maybe TLSSettings
mtls =
Maybe ConnectionContext
-> Maybe TLSSettings
-> Restriction
-> ManagerSettings
-> IO (ManagerSettings, Maybe ProxyRestricted)
restrictManagerSettings Maybe ConnectionContext
mcontext Maybe TLSSettings
mtls Restriction
cfg (ManagerSettings -> IO (ManagerSettings, Maybe ProxyRestricted))
-> ManagerSettings -> IO (ManagerSettings, Maybe ProxyRestricted)
forall a b. (a -> b) -> a -> b
$
Maybe ConnectionContext
-> TLSSettings -> Maybe SockSettings -> ManagerSettings
mkManagerSettingsContext Maybe ConnectionContext
mcontext (TLSSettings -> Maybe TLSSettings -> TLSSettings
forall a. a -> Maybe a -> a
fromMaybe TLSSettings
forall a. Default a => a
def Maybe TLSSettings
mtls) Maybe SockSettings
forall a. Maybe a
Nothing
restrictProxy
:: Restriction
-> ManagerSettings
-> IO (ManagerSettings, Maybe ProxyRestricted)
restrictProxy :: Restriction
-> ManagerSettings -> IO (ManagerSettings, Maybe ProxyRestricted)
restrictProxy Restriction
cfg ManagerSettings
base = do
Maybe AddrInfo
http_proxy_addr <- Bool -> IO (Maybe AddrInfo)
getproxyaddr Bool
False
Maybe AddrInfo
https_proxy_addr <- Bool -> IO (Maybe AddrInfo)
getproxyaddr Bool
True
let (ProxyOverride
http_proxy, Maybe ProxyRestricted
http_r) = Maybe AddrInfo -> (ProxyOverride, Maybe ProxyRestricted)
mkproxy Maybe AddrInfo
http_proxy_addr
let (ProxyOverride
https_proxy, Maybe ProxyRestricted
https_r) = Maybe AddrInfo -> (ProxyOverride, Maybe ProxyRestricted)
mkproxy Maybe AddrInfo
https_proxy_addr
let ms :: ManagerSettings
ms = ProxyOverride -> ManagerSettings -> ManagerSettings
managerSetInsecureProxy ProxyOverride
http_proxy (ManagerSettings -> ManagerSettings)
-> ManagerSettings -> ManagerSettings
forall a b. (a -> b) -> a -> b
$
ProxyOverride -> ManagerSettings -> ManagerSettings
managerSetSecureProxy ProxyOverride
https_proxy ManagerSettings
base
(ManagerSettings, Maybe ProxyRestricted)
-> IO (ManagerSettings, Maybe ProxyRestricted)
forall (m :: * -> *) a. Monad m => a -> m a
return (ManagerSettings
ms, Maybe ProxyRestricted
http_r Maybe ProxyRestricted
-> Maybe ProxyRestricted -> Maybe ProxyRestricted
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ProxyRestricted
https_r)
where
testnetip :: String
testnetip = String
"198.51.100.1"
dummyreq :: Bool -> Request
dummyreq Bool
https = String -> Request
parseRequest_ (String -> Request) -> String -> Request
forall a b. (a -> b) -> a -> b
$
String
"http" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Bool
https then String
"s" else String
"") String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"://" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
testnetip
getproxyaddr :: Bool -> IO (Maybe AddrInfo)
getproxyaddr Bool
https = IO (Maybe Proxy)
extractproxy IO (Maybe Proxy)
-> (Maybe Proxy -> IO (Maybe AddrInfo)) -> IO (Maybe AddrInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Proxy
Nothing -> Maybe AddrInfo -> IO (Maybe AddrInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AddrInfo
forall a. Maybe a
Nothing
Just Proxy
p -> do
ProtocolNumber
proto <- String -> IO ProtocolNumber
getProtocolNumber String
"tcp"
let serv :: String
serv = Int -> String
forall a. Show a => a -> String
show (Proxy -> Int
proxyPort Proxy
p)
let hints :: AddrInfo
hints = AddrInfo
defaultHints
{ addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_ADDRCONFIG]
, addrProtocol :: ProtocolNumber
addrProtocol = ProtocolNumber
proto
, addrSocketType :: SocketType
addrSocketType = SocketType
Stream
}
let h :: String
h = ByteString -> String
BU.toString (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Proxy -> ByteString
proxyHost Proxy
p
Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
h) (String -> Maybe String
forall a. a -> Maybe a
Just String
serv) IO [AddrInfo]
-> ([AddrInfo] -> IO (Maybe AddrInfo)) -> IO (Maybe AddrInfo)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
[] -> Maybe AddrInfo -> IO (Maybe AddrInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AddrInfo
forall a. Maybe a
Nothing
(AddrInfo
addr:[AddrInfo]
_) -> Maybe AddrInfo -> IO (Maybe AddrInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe AddrInfo -> IO (Maybe AddrInfo))
-> Maybe AddrInfo -> IO (Maybe AddrInfo)
forall a b. (a -> b) -> a -> b
$ AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
addr
where
extractproxy :: IO (Maybe Proxy)
extractproxy = do
let po :: ProxyOverride
po = if Bool
https
then ManagerSettings -> ProxyOverride
managerProxySecure ManagerSettings
base
else ManagerSettings -> ProxyOverride
managerProxyInsecure ManagerSettings
base
Request -> Request
f <- ProxyOverride -> Bool -> IO (Request -> Request)
runProxyOverride ProxyOverride
po Bool
https
Maybe Proxy -> IO (Maybe Proxy)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Proxy -> IO (Maybe Proxy))
-> Maybe Proxy -> IO (Maybe Proxy)
forall a b. (a -> b) -> a -> b
$ Request -> Maybe Proxy
proxy (Request -> Maybe Proxy) -> Request -> Maybe Proxy
forall a b. (a -> b) -> a -> b
$ Request -> Request
f (Request -> Request) -> Request -> Request
forall a b. (a -> b) -> a -> b
$ Bool -> Request
dummyreq Bool
https
mkproxy :: Maybe AddrInfo -> (ProxyOverride, Maybe ProxyRestricted)
mkproxy Maybe AddrInfo
Nothing = (ProxyOverride
noProxy, Maybe ProxyRestricted
forall a. Maybe a
Nothing)
mkproxy (Just AddrInfo
proxyaddr) = case Restriction -> AddrInfo -> Maybe ConnectionRestricted
checkAddressRestriction Restriction
cfg AddrInfo
proxyaddr of
Maybe ConnectionRestricted
Nothing -> (SockAddr -> ProxyOverride
addrtoproxy (AddrInfo -> SockAddr
addrAddress AddrInfo
proxyaddr), Maybe ProxyRestricted
forall a. Maybe a
Nothing)
Just ConnectionRestricted
_ -> (ProxyOverride
noProxy, ProxyRestricted -> Maybe ProxyRestricted
forall a. a -> Maybe a
Just ProxyRestricted
ProxyRestricted)
addrtoproxy :: SockAddr -> ProxyOverride
addrtoproxy SockAddr
addr = case SockAddr
addr of
SockAddrInet PortNumber
pn HostAddress
_ -> PortNumber -> ProxyOverride
forall a. Integral a => a -> ProxyOverride
mk PortNumber
pn
SockAddrInet6 PortNumber
pn HostAddress
_ HostAddress6
_ HostAddress
_ -> PortNumber -> ProxyOverride
forall a. Integral a => a -> ProxyOverride
mk PortNumber
pn
SockAddr
_ -> ProxyOverride
noProxy
where
mk :: a -> ProxyOverride
mk a
pn = Proxy -> ProxyOverride
useProxy Proxy :: ByteString -> Int -> Proxy
Network.HTTP.Client.Proxy
{ proxyHost :: ByteString
proxyHost = String -> ByteString
BU.fromString (SockAddr -> String
showSockAddress SockAddr
addr)
, proxyPort :: Int
proxyPort = a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
pn
}
wrapOurExceptions :: ManagerSettings -> Request -> IO a -> IO a
wrapOurExceptions :: ManagerSettings -> Request -> IO a -> IO a
wrapOurExceptions ManagerSettings
base Request
req IO a
a =
let wrapper :: SomeException -> SomeException
wrapper SomeException
se
| Just (ConnectionRestricted
_ :: ConnectionRestricted) <- SomeException -> Maybe ConnectionRestricted
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se =
HttpException -> SomeException
forall e. Exception e => e -> SomeException
toException (HttpException -> SomeException) -> HttpException -> SomeException
forall a b. (a -> b) -> a -> b
$ Request -> HttpExceptionContent -> HttpException
HttpExceptionRequest Request
req (HttpExceptionContent -> HttpException)
-> HttpExceptionContent -> HttpException
forall a b. (a -> b) -> a -> b
$
SomeException -> HttpExceptionContent
InternalException SomeException
se
| Bool
otherwise = SomeException
se
in ManagerSettings -> Request -> IO a -> IO a
ManagerSettings -> forall a. Request -> IO a -> IO a
managerWrapException ManagerSettings
base Request
req ((SomeException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO (SomeException -> IO a)
-> (SomeException -> SomeException) -> SomeException -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> SomeException
wrapper) IO a
a)
restrictedRawConnection :: Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection)
restrictedRawConnection :: Restriction
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
restrictedRawConnection Restriction
cfg = Restriction
-> Maybe TLSSettings
-> Maybe ConnectionContext
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
getConnection Restriction
cfg Maybe TLSSettings
forall a. Maybe a
Nothing Maybe ConnectionContext
forall a. Maybe a
Nothing
restrictedTlsConnection :: Maybe NC.ConnectionContext -> Maybe NC.TLSSettings -> Restriction -> IO (Maybe HostAddress -> String -> Int -> IO Connection)
restrictedTlsConnection :: Maybe ConnectionContext
-> Maybe TLSSettings
-> Restriction
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
restrictedTlsConnection Maybe ConnectionContext
mcontext Maybe TLSSettings
mtls Restriction
cfg =
Restriction
-> Maybe TLSSettings
-> Maybe ConnectionContext
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
getConnection Restriction
cfg (TLSSettings -> Maybe TLSSettings
forall a. a -> Maybe a
Just (TLSSettings -> Maybe TLSSettings -> TLSSettings
forall a. a -> Maybe a -> a
fromMaybe TLSSettings
forall a. Default a => a
def Maybe TLSSettings
mtls)) Maybe ConnectionContext
mcontext
getConnection
:: Restriction
-> Maybe NC.TLSSettings
-> Maybe NC.ConnectionContext
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
getConnection :: Restriction
-> Maybe TLSSettings
-> Maybe ConnectionContext
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
getConnection Restriction
cfg Maybe TLSSettings
tls Maybe ConnectionContext
mcontext = do
ConnectionContext
context <- IO ConnectionContext
-> (ConnectionContext -> IO ConnectionContext)
-> Maybe ConnectionContext
-> IO ConnectionContext
forall b a. b -> (a -> b) -> Maybe a -> b
maybe IO ConnectionContext
NC.initConnectionContext ConnectionContext -> IO ConnectionContext
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ConnectionContext
mcontext
(Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection))
-> (Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall a b. (a -> b) -> a -> b
$ \Maybe HostAddress
_ha String
h Int
p -> IO Connection
-> (Connection -> IO ())
-> (Connection -> IO Connection)
-> IO Connection
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
(ConnectionContext -> String -> Int -> IO Connection
forall a.
(Integral a, Show a) =>
ConnectionContext -> String -> a -> IO Connection
go ConnectionContext
context String
h Int
p)
Connection -> IO ()
NC.connectionClose
Connection -> IO Connection
convertConnection
where
go :: ConnectionContext -> String -> a -> IO Connection
go ConnectionContext
context String
h a
p = do
let connparams :: ConnectionParams
connparams = ConnectionParams :: String
-> PortNumber
-> Maybe TLSSettings
-> Maybe SockSettings
-> ConnectionParams
NC.ConnectionParams
{ connectionHostname :: String
NC.connectionHostname = String
hstripped
, connectionPort :: PortNumber
NC.connectionPort = a -> PortNumber
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
p
, connectionUseSecure :: Maybe TLSSettings
NC.connectionUseSecure = Maybe TLSSettings
tls
, connectionUseSocks :: Maybe SockSettings
NC.connectionUseSocks = Maybe SockSettings
forall a. Maybe a
Nothing
}
ProtocolNumber
proto <- String -> IO ProtocolNumber
getProtocolNumber String
"tcp"
let serv :: String
serv = a -> String
forall a. Show a => a -> String
show a
p
let hints :: AddrInfo
hints = AddrInfo
defaultHints
{ addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_ADDRCONFIG]
, addrProtocol :: ProtocolNumber
addrProtocol = ProtocolNumber
proto
, addrSocketType :: SocketType
addrSocketType = SocketType
Stream
}
[AddrInfo]
addrs <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
hstripped) (String -> Maybe String
forall a. a -> Maybe a
Just String
serv)
IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Connection) -> IO Connection
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
([IO Socket] -> IO Socket
forall a. [IO a] -> IO a
firstSuccessful ([IO Socket] -> IO Socket) -> [IO Socket] -> IO Socket
forall a b. (a -> b) -> a -> b
$ (AddrInfo -> IO Socket) -> [AddrInfo] -> [IO Socket]
forall a b. (a -> b) -> [a] -> [b]
map AddrInfo -> IO Socket
tryToConnect [AddrInfo]
addrs)
Socket -> IO ()
close
(\Socket
sock -> ConnectionContext -> Socket -> ConnectionParams -> IO Connection
NC.connectFromSocket ConnectionContext
context Socket
sock ConnectionParams
connparams)
where
hstripped :: String
hstripped = ShowS
strippedHostName String
h
tryToConnect :: AddrInfo -> IO Socket
tryToConnect AddrInfo
addr = case Restriction -> AddrInfo -> Maybe ConnectionRestricted
checkAddressRestriction Restriction
cfg AddrInfo
addr of
Maybe ConnectionRestricted
Nothing -> IO Socket
-> (Socket -> IO ()) -> (Socket -> IO Socket) -> IO Socket
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
(Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
addr) (AddrInfo -> SocketType
addrSocketType AddrInfo
addr) (AddrInfo -> ProtocolNumber
addrProtocol AddrInfo
addr))
Socket -> IO ()
close
(\Socket
sock -> Socket -> SockAddr -> IO ()
connect Socket
sock (AddrInfo -> SockAddr
addrAddress AddrInfo
addr) IO () -> IO Socket -> IO Socket
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock)
Just ConnectionRestricted
r -> ConnectionRestricted -> IO Socket
forall e a. Exception e => e -> IO a
throwIO ConnectionRestricted
r
firstSuccessful :: [IO a] -> IO a
firstSuccessful [] = HostNotResolved -> IO a
forall e a. Exception e => e -> IO a
throwIO (HostNotResolved -> IO a) -> HostNotResolved -> IO a
forall a b. (a -> b) -> a -> b
$ String -> HostNotResolved
NC.HostNotResolved String
hstripped
firstSuccessful (IO a
a:[IO a]
as) = IO a
a IO a -> (IOException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` \(IOException
e ::IOException) ->
case [IO a]
as of
[] -> IOException -> IO a
forall e a. Exception e => e -> IO a
throwIO IOException
e
[IO a]
_ -> [IO a] -> IO a
firstSuccessful [IO a]
as
convertConnection :: NC.Connection -> IO Connection
convertConnection :: Connection -> IO Connection
convertConnection Connection
conn = IO ByteString -> (ByteString -> IO ()) -> IO () -> IO Connection
makeConnection
(Connection -> IO ByteString
NC.connectionGetChunk Connection
conn)
(Connection -> ByteString -> IO ()
NC.connectionPut Connection
conn)
(Connection -> IO ()
NC.connectionClose Connection
conn IO () -> (IOException -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`Control.Exception.catch` \(IOException
_ :: IOException) -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
showSockAddress :: SockAddr -> IPAddrString
showSockAddress :: SockAddr -> String
showSockAddress a :: SockAddr
a@(SockAddrInet PortNumber
_ HostAddress
_) =
(Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
':') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ SockAddr -> String
forall a. Show a => a -> String
show SockAddr
a
showSockAddress a :: SockAddr
a@(SockAddrInet6 PortNumber
_ HostAddress
_ HostAddress6
_ HostAddress
_) =
(Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
']') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ SockAddr -> String
forall a. Show a => a -> String
show SockAddr
a
showSockAddress SockAddr
a = SockAddr -> String
forall a. Show a => a -> String
show SockAddr
a