{-# 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")