module Jingle.Socks5Server (start) where

import Prelude ()
import BasicPrelude
import System.IO (IOMode(ReadMode))
import Network.Socks5.Types
	(SocksReply(SocksReplySuccess), SocksHostAddress(SocksAddrDomainName))
import Network.Socks5.Lowlevel
	(socksListen, requestDstAddr, sendSerialized, SocksResponse(..))
import UnexceptionalIO (UIO, Unexceptional)
import qualified UnexceptionalIO as UIO
import qualified Data.ByteString as ByteString
import qualified Network.Socket as Socket

import StoreChunks
import Util

start :: (Unexceptional m) =>
	   FilePath
	-> [Socket.SockAddr]
	-> (String -> UIO ())
	-> (JingleTSID -> FilePath -> UIO ())
	-> m (Either IOError ())
start storePath ports logger transferFinished = UIO.fromIO' (error.show) $
	forM_ ports $ \port -> do
		Just family <- return $ addrToFamily port
		socket <- Socket.socket family Socket.Stream 0
		Socket.setSocketOption socket Socket.ReuseAddr 1
		Socket.bind socket port
		Socket.listen socket 5
		void $ UIO.fork (threadLoop port socket)
	where
	addrToFamily Socket.SockAddrInet {} = Just Socket.AF_INET
	addrToFamily Socket.SockAddrInet6 {} = Just Socket.AF_INET6
	addrToFamily _ = Nothing

	exceptionLogger :: IOError -> UIO ()
	exceptionLogger = logger . show

	threadLoop port socket =
		afterAccept port socket =<<
		UIO.fromIO' (error.show) (Socket.accept socket)

	afterAccept port socket (Right (conn, _)) = do
		void $ UIO.forkFinally
			(UIO.fromIO' (error.show) $ processConnection conn)
			afterAfterAccept
		threadLoop port socket
	afterAccept port socket (Left e) = do
		exceptionLogger e
		UIO.unsafeFromIO $ Socket.close socket
		-- Should these just get logged, or should the process die if we
		-- cannot restart?
		either exceptionLogger return =<<
			start storePath [port] logger transferFinished

	afterAfterAccept (Right (Right ())) = return ()
	afterAfterAccept (Right (Left e)) = exceptionLogger e
	afterAfterAccept (Left e) = logger $ show e

	processConnection conn = do
		request <- socksListen conn
		let SocksAddrDomainName addr = requestDstAddr request
		let taddr = decodeUtf8 addr
		let saddr = textToString taddr
		sendSerialized conn $ SocksResponse
			SocksReplySuccess (SocksAddrDomainName addr) 0
		h <- Socket.socketToHandle conn ReadMode
		(path, _, _, _) <- UIO.runEitherIO $ storeChunks storePath saddr
			(fromIO_ $ Just <$> ByteString.hGet h 4096)
		UIO.run $ transferFinished (JingleTSID taddr) path