hstorchat-0.1.0.0: src/Main.hs

{-# LANGUAGE OverloadedStrings #-}
module Main where

import Control.Concurrent
import Control.Exception
import Control.Monad
import qualified Data.Map as M
import Data.Text as T
import Graphics.QML
import Network.Socket
import System.IO
import System.Process

import Network.HSTorChat.Client
import Network.HSTorChat.Protocol

import Paths_hstorchat


gentorrc :: String -> IO ()
gentorrc dd = writeFile (dd ++ "/torrc") $ Prelude.unlines
                [ "SocksPort " ++ socksport
                -- we don't use the control port currently, so leave this alone
                --, "ControlPort 11119"
                -- INCOMING connections for the hidden service arrive at 11009
                -- and will be forwarded to TorChat at 127.0.0.1:22009
                , "HiddenServiceDir " ++ dd ++ "/hidden_service"
                , "HiddenServicePort " ++ hsport ++ " 127.0.0.1:" ++ hstcport
                -- where should tor store it's cache files
                , "DataDirectory " ++ dd ++ " tor_data"
                -- some tuning
                , "AvoidDiskWrites 1"
                , "LongLivedPorts " ++ hstcport
                , "FetchDirInfoEarly 1"
                , "CircuitBuildTimeout 30"
                , "NumEntryGuards 6"
                -- You can uncomment the lines below to log Tor's activity to the
                -- console or to a log file. Use this only during debugging!
                -- Turning off SaveLogging will leave sensitive information on your disk,
                -- the built in default is save logging turned on (set to 1).
                -- so don't remove the # from that line unless you need it
                -- and remember to put it in again, after you are done.
                --, "Log info File tor.log"
                --, "Log info stdout"
                --, "SafeLogging 0"
                ]
  where hsport    = show hstorchatHSPort
        hstcport  = show hstorchatLocalPort
        socksport = show torSocksPort

-- | Wait until the hidden service hostname file
-- is ready
hiddenServiceName :: IO String
hiddenServiceName = catch (do dd <- getDataDir
                              readFile $ dd ++ "/hidden_service/hostname")
                          (\e -> print (e :: IOException)
                              >> threadDelay 5000
                              >> hiddenServiceName)

main :: IO ()
main = withSocketsDo $ do

    dd <- getDataDir
    gentorrc dd
    _ <- createProcess $ proc "tor" ["-f", dd ++ "/torrc"]

    onion <- hiddenServiceName
    let myonion = T.take 16 $ T.pack onion
    putStr $ "Hello " ++ onion
    sock <- socket AF_INET Stream 0
    setSocketOption sock ReuseAddr 1

    li <- inet_addr hstorchatHost
    bindSocket sock $ SockAddrInet hstorchatLocalPort li
    listen sock 2

    buddies <- newMVar M.empty
    p <- newMVar []

    tc <- newObjectDC $ TorChat myonion Available buddies p

    _ <- forkIO $ forever $ do
            (insock,_) <- accept sock
            iHdl <- socketToHandle insock ReadWriteMode
            hSetBuffering iHdl LineBuffering
            forkIO $ newConnectionRequest tc iHdl

    doc <- getDataFileName "qml/HSTorChat.qml"
    runEngineLoop defaultEngineConfig {
      initialDocument = fileDocument doc
    , contextObject   = Just $ anyObjRef tc
    }