Runtime.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}

module Network.MoeSocks.Runtime where

import           Control.Lens
import           Control.Monad.Except (ExceptT, throwError)
import           Data.IP (IPRange)
import           Data.Monoid ((<>))
import qualified Data.Text as T
import           Data.Text.IO as T
import           Data.Text.Lens (_Text)
import qualified Network.MoeSocks.Type.Bootstrap.Config as C
import qualified Network.MoeSocks.Type.Bootstrap.Option as O
import qualified System.IO as IO
import           System.Log.Formatter (simpleLogFormatter)
import qualified System.Log.Handler as LogHandler
import           System.Log.Handler.Simple (streamHandler)
import           System.Log.Logger (Priority(DEBUG), removeHandler, addHandler, setLevel)
import           System.Log.Logger (updateGlobalLogger, rootLoggerName)

import           Network.MoeSocks.Bootstrap (loadConfig)
import           Network.MoeSocks.Default (defaultRuntime, parseIPRangeList, defaultEnv)
import           Network.MoeSocks.Encrypt (initCipherBox)
import           Network.MoeSocks.Type

import           Prelude hiding ((-), take)
import           Network.MoeSocks.Helper ((-), debug_, io, is)

initLogger :: Priority -> IO ()
initLogger aLevel = do
  stdoutHandler <- streamHandler IO.stdout DEBUG
  let formattedHandler =
          LogHandler.setFormatter stdoutHandler -
            --"[$time : $loggername : $prio]
            simpleLogFormatter "$time $prio\t $msg"

  updateGlobalLogger rootLoggerName removeHandler

  updateGlobalLogger "moe" removeHandler
  updateGlobalLogger "moe" - addHandler formattedHandler
  updateGlobalLogger "moe" - setLevel aLevel



loadJobs :: C.Config -> O.Options -> [Job]
loadJobs aConfig someOptions =
  let _c = aConfig

      _remote_TCP_Relay =
          RemoteRelay
            Remote_TCP_Relay
            (_c ^. C.remoteHost)
            (_c ^. C.remotePort)

      _remote_UDP_Relay =
          RemoteRelay
            Remote_UDP_Relay
            (_c ^. C.remoteHost)
            (_c ^. C.remotePort)

      _localService :: LocalServiceType -> LocalService
      _localService = LocalService
                        (_c ^. C.localHost)
                        (_c ^. C.remoteHost)
                        (_c ^. C.remotePort)

      _localService_TCP_Forwards =
          someOptions ^. O.forward_TCPs
            & map (_localService . LocalService_TCP_Forward)

      _localService_UDP_Forwards =
          someOptions ^. O.forward_UDPs
            & map (_localService . LocalService_UDP_Forward)

      _localService_SOCKS5 =
          LocalService_SOCKS5 (_c ^. C.localPort)
            & _localService

      _remoteRelays = [_remote_TCP_Relay, _remote_UDP_Relay]
      _localServices =
        let
          _localService_SOCKS5s =
            if someOptions ^. O.disable_SOCKS5
              then []
              else pure _localService_SOCKS5
        in

        _localService_TCP_Forwards
        <> _localService_UDP_Forwards
        <> _localService_SOCKS5s
  in

  map RemoteRelayJob _remoteRelays
  <> map LocalServiceJob _localServices

filterJobs :: O.RunningMode -> [Job] -> [Job]
filterJobs = \case
  O.DebugMode -> id
  O.RemoteMode -> filter - is _RemoteRelayJob
  O.LocalMode -> filter - is _LocalServiceJob


initEnv :: C.Config -> O.Options -> ExceptT String IO Env
initEnv aConfig someOptions = do
  let _o = someOptions
      _c = aConfig

  io - initLogger - _o ^. O.verbosity
  io - debug_ - show _o

  _config <- loadConfig - _o

  let _method = _c ^. C.method

  _cipherBox <- (io - initCipherBox _method (_c ^. C.password)) >>= \case
    Nothing -> throwError - "Invalid method '"
                            <> _method ^. _Text
    Just (a, b, c, d) -> pure - CipherBox a b c d

  let _readDenyList :: IO [IPRange]
      _readDenyList =
        case someOptions ^. O.denyList of
          Nothing -> pure []
          Just _denyListPath ->
            T.readFile (_denyListPath ^. _Text)
              <&> T.lines
              <&> parseIPRangeList


  _denyList <- io - _readDenyList

  io - debug_ - "denyList: " <> show (length _denyList) <> " items"

  let _env = defaultEnv
              & cipherBox .~ _cipherBox
              & denyList .~ _denyList

  pure - _env

initRuntime :: C.Config -> O.Options -> ExceptT String IO (Runtime)
initRuntime aConfig someOptions = do
  let _c = aConfig
      _o = someOptions
      _s = _c ^. C.socketOption_TCP_NOTSENT_LOWAT

  _env <- initEnv aConfig someOptions

  let _env' = _env
        & timeout                        .~ _c ^. C.timeout
        & throttle                       .~ _c ^. C.throttle
        & throttleSpeed                  .~ _c ^. C.throttleSpeed
        & obfuscationFlushBound          .~ _c ^. C.obfuscationFlushBound
        & fastOpen                       .~ _c ^. C.fastOpen
        & socketOption_TCP_NOTSENT_LOWAT .~ _s
        & obfuscation                    .~ _o ^. O.obfuscation
        & forbidden_IPs                  .~ (_c ^. C.forbidden_IPs
                                                & parseIPRangeList)



  let _jobs = loadJobs _c _o & filterJobs (_o ^. O.runningMode)

  pure -  ( defaultRuntime
              & env .~ _env'
              & jobs .~ _jobs
          )