module GitHUD.Daemon.Network (
  sendOnSocket,
  receiveOnSocket,
  ) where

import Control.Concurrent (forkFinally)
import qualified Control.Exception as E
import Control.Monad (forever, void, when)
import qualified Data.ByteString as S
import qualified Data.ByteString.UTF8 as BSU
import Network.Socket (Family(AF_UNIX), socket, defaultProtocol, Socket, SocketType(Stream), close, listen, accept, bind, SockAddr(SockAddrUnix), connect)
import Network.Socket.ByteString (recv, sendAll)
import System.Directory (removeFile)
import System.Posix.Files (fileExist)

sendOnSocket :: FilePath
             -> String
             -> IO ()
sendOnSocket :: FilePath -> FilePath -> IO ()
sendOnSocket FilePath
socketPath FilePath
msg =
  IO (Maybe Socket)
-> (Maybe Socket -> IO ()) -> (Maybe Socket -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket IO (Maybe Socket)
open Maybe Socket -> IO ()
mClose (FilePath -> Maybe Socket -> IO ()
mTalkOnClientSocket FilePath
msg)
  where
    open :: IO (Maybe Socket)
open = do
        Bool
socketExists <- FilePath -> IO Bool
fileExist FilePath
socketPath
        if Bool
socketExists
          then do
            Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_UNIX SocketType
Stream ProtocolNumber
defaultProtocol
            Socket -> SockAddr -> IO ()
connect Socket
sock (FilePath -> SockAddr
SockAddrUnix FilePath
socketPath)
            Maybe Socket -> IO (Maybe Socket)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Socket -> IO (Maybe Socket))
-> Maybe Socket -> IO (Maybe Socket)
forall a b. (a -> b) -> a -> b
$ Socket -> Maybe Socket
forall a. a -> Maybe a
Just Socket
sock
          else Maybe Socket -> IO (Maybe Socket)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Socket
forall a. Maybe a
Nothing
    mClose :: Maybe Socket -> IO ()
mClose = IO () -> (Socket -> IO ()) -> Maybe Socket -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Socket -> IO ()
close

mTalkOnClientSocket :: String
                    -> Maybe Socket
                    -> IO ()
mTalkOnClientSocket :: FilePath -> Maybe Socket -> IO ()
mTalkOnClientSocket FilePath
_ Maybe Socket
Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mTalkOnClientSocket FilePath
msg (Just Socket
sock) = Socket -> ByteString -> IO ()
sendAll Socket
sock (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString
BSU.fromString FilePath
msg

receiveOnSocket :: FilePath
                -> (String -> IO m)
                -> IO ()
receiveOnSocket :: FilePath -> (FilePath -> IO m) -> IO ()
receiveOnSocket FilePath
socketPath FilePath -> IO m
withMessageCb = do
  Bool
socketExists <- FilePath -> IO Bool
fileExist FilePath
socketPath
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
socketExists (FilePath -> IO ()
removeFile FilePath
socketPath)
  IO Socket -> (Socket -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket IO Socket
open Socket -> IO ()
close Socket -> IO ()
forall b. Socket -> IO b
loop
  where
    open :: IO Socket
open = do
      Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_UNIX SocketType
Stream ProtocolNumber
defaultProtocol
      Socket -> SockAddr -> IO ()
bind Socket
sock (FilePath -> SockAddr
SockAddrUnix FilePath
socketPath)
      Socket -> Int -> IO ()
listen Socket
sock Int
1
      Socket -> IO Socket
forall (m :: * -> *) a. Monad m => a -> m a
return Socket
sock
    loop :: Socket -> IO b
loop Socket
sock = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ do
      (Socket
conn, SockAddr
peer) <- Socket -> IO (Socket, SockAddr)
accept Socket
sock
      IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> IO ThreadId -> IO ()
forall a b. (a -> b) -> a -> b
$ IO m -> (Either SomeException m -> IO ()) -> IO ThreadId
forall a. IO a -> (Either SomeException a -> IO ()) -> IO ThreadId
forkFinally (Socket -> IO m
talk Socket
conn) (\Either SomeException m
_ -> Socket -> IO ()
close Socket
conn)
    talk :: Socket -> IO m
talk Socket
conn = (Socket -> FilePath -> IO FilePath
readPacket Socket
conn FilePath
"") IO FilePath -> (FilePath -> IO m) -> IO m
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath -> IO m
withMessageCb
    readPacket :: Socket -> FilePath -> IO FilePath
readPacket Socket
conn FilePath
acc = do
      ByteString
msg <- Socket -> Int -> IO ByteString
recv Socket
conn Int
1024
      if (ByteString -> Bool
S.null ByteString
msg)
        then FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
acc
        else Socket -> FilePath -> IO FilePath
readPacket Socket
conn (FilePath
acc FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (ByteString -> FilePath
BSU.toString ByteString
msg))