aboutsummaryrefslogtreecommitdiffstats
path: root/src/Network
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2020-04-17 22:41:53 +0200
committertv <tv@krebsco.de>2020-04-17 23:11:07 +0200
commit7dfc802b753f21afcb656b13d30d49bc548ac150 (patch)
tree664d84c3f6ec28b7affc26b509ddc608bd06939d /src/Network
parentd6d51de7c9d54691b33a8ae9691fd0402259006a (diff)
Reaktor.API: make configurable
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/Socket/Extended.hs78
1 files changed, 78 insertions, 0 deletions
diff --git a/src/Network/Socket/Extended.hs b/src/Network/Socket/Extended.hs
new file mode 100644
index 0000000..8d71956
--- /dev/null
+++ b/src/Network/Socket/Extended.hs
@@ -0,0 +1,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")
+