blob: 8d719566f36dcd0dd39220d62cced305cffe6550 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
module Network.Socket.Extended
( module Exports
, openSocket
, closeSocket
, getAddrFamily
, getAddrPort
, readListenString
) where
import qualified Network.Socket as Exports
import Network.Socket
import Network.URI
import Network.Wai.Handler.Warp (Port)
import System.Posix.Files.Extended (removeIfExists)
openSocket :: SockAddr -> IO Socket
openSocket sockAddr = do
let family = getAddrFamily sockAddr
case sockAddr of
SockAddrUnix sockFile -> removeIfExists sockFile
_ -> return ()
socket family Stream defaultProtocol
closeSocket :: Socket -> IO ()
closeSocket sock = do
name <- getSocketName sock
close sock
case name of
SockAddrUnix sockFile -> removeIfExists sockFile
_ -> return ()
getAddrFamily :: SockAddr -> Family
getAddrFamily = \case
SockAddrInet _ _ -> AF_INET
SockAddrInet6 _ _ _ _ -> AF_INET6
SockAddrUnix _ -> AF_UNIX
sockAddr -> error ("getAddrFamily: don't know family of " <> show sockAddr)
getAddrPort :: SockAddr -> Port
getAddrPort = \case
SockAddrInet portNumber _ -> fromIntegral portNumber
SockAddrInet6 portNumber _ _ _ -> fromIntegral portNumber
_ -> 0
readListenString :: String -> IO (Either String SockAddr)
readListenString cListen =
case parseURI cListen of
Just URI{..} ->
case uriScheme of
"inet:" ->
case uriAuthority of
Just URIAuth{..} -> do
let
hostName =
if uriRegName == "" then
Nothing
else
Just uriRegName
serviceName =
if uriPort == "" then
Nothing
else
Just (tail uriPort)
AddrInfo{..}:_ <-
getAddrInfo Nothing hostName serviceName
return (Right addrAddress)
Nothing ->
return (Left "could not parse inet listen string")
"unix:" ->
return (Right (SockAddrUnix uriPath))
invalid ->
return (Left ("unsupported listen scheme: " <> invalid))
Nothing ->
return (Left "could not parse listen string")
|
