From 7dfc802b753f21afcb656b13d30d49bc548ac150 Mon Sep 17 00:00:00 2001
From: tv <tv@krebsco.de>
Date: Fri, 17 Apr 2020 22:41:53 +0200
Subject: Reaktor.API: make configurable

---
 src/Network/Socket/Extended.hs | 78 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 78 insertions(+)
 create mode 100644 src/Network/Socket/Extended.hs

(limited to 'src/Network')

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")
+
-- 
cgit v1.2.3