aboutsummaryrefslogtreecommitdiffstats
path: root/src/Network/Socket/Extended.hs
blob: 15d6e33820cbd687b0043bedc3bf915acb7b8909 (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
79
80
81
82
83
84
85
86
87
88
89
90
91
92
{-# 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
    ( AddrInfo(AddrInfo)
    , Family(AF_UNIX, AF_INET, AF_INET6)
    , SockAddr(SockAddrInet, SockAddrInet6, SockAddrUnix)
    , Socket
    , SocketType(Stream)
    , bind
    , close
    , defaultProtocol
    , getAddrInfo
    , getSocketName
    , listen
    , maxListenQueue
    , 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")