Bootstrap.hs

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

module Network.MoeSocks.Bootstrap where

import           Control.Lens
import           Control.Monad.Except (ExceptT, throwError)
import           Control.Monad.Writer hiding (listen)
import           Data.Aeson hiding (Result)
import           Data.Aeson.Lens (_Object, _JSON)
import           Data.Maybe (fromMaybe)
import           Data.Text (Text)
import           Data.Text.Lens (_Text)
import qualified Data.HashMap.Strict as H
import qualified Data.Map as Map
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

import qualified Network.MoeSocks.Type.Bootstrap.Config as C
import qualified Network.MoeSocks.Type.Bootstrap.Option as O
import           Network.MoeSocks.Default (defaultConfig)
import           Network.MoeSocks.Encrypt (safeMethods, unsafeMethods)

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


asList :: ([(Text, Value)] -> [(Text, Value)]) -> Value -> Value
asList f = over _Object - H.fromList . f . H.toList

toReadableConfig :: Value -> Value
toReadableConfig = asList - each . _1 %~ T.tail

showConfig :: C.Config -> Text
showConfig =  review _JSON
              . toReadableConfig
              . review _JSON

withGateOptions :: O.Options -> IO a -> IO ()
withGateOptions someOptions aIO = do
  let _br = putStrLn ""

  if someOptions ^. O.listMethods
    then do
      _br
      putStrLn "Recommended:"
      itraverse_ (\k _ -> putStrLn - "\t\t" <> k ^. _Text) - safeMethods

      _br
      putStrLn "Supported:"
      itraverse_ (\k _ -> putStrLn - "\t\t" <> k ^. _Text) - unsafeMethods

    else
      if someOptions ^. O.showDefaultConfig
        then
          putStrLn - showConfig defaultConfig ^. _Text
        else
          () <$ aIO

loadConfig :: O.Options -> ExceptT String IO C.Config
loadConfig someOptions = do
  let _maybeFilePath = someOptions ^. O.configFile

  _v <- case _maybeFilePath of
          Nothing -> pure - Just - Object mempty
          Just _filePath -> fmap (preview _JSON) -
                            io - TIO.readFile - _filePath ^. _Text

  let

      fixConfig:: Text -> Text
      fixConfig x =
        let _remoteHost = "remoteHost"
            _remotePort = "remotePort"
            _localHost = "localHost"

            fixes = Map.fromList
              [
                ("server"       , _remoteHost )
              , ("remote"       , _remoteHost )
              , ("remoteAddress", _remoteHost )

              , ("server_port"  , _remotePort )

              , ("local"        , _localHost  )
              , ("localAddress" , _localHost  )
              , ("local_address", _localHost  )

              ]

        in
        fixes ^? ix x & fromMaybe x

      toParsableConfig :: Value -> Value
      toParsableConfig = asList - each . _1 %~  (
                                                  T.cons '_'
                                                . toHaskellNamingConvention
                                                . fixConfig
                                                )

      filterEssentialConfig :: Value -> Value
      filterEssentialConfig = over _Object - \_obj ->
                                foldl (flip H.delete) _obj -
                                  [
                                    "_password"
                                  ]

      insertConfig :: Value -> Value -> Value
      insertConfig (Object _from) = over _Object (_from `H.union`)
      insertConfig _ = const Null

      insertParams :: [(Text, Value)] -> Value -> Value
      insertParams _from = over _Object (H.fromList _from `H.union`)

      fallbackConfig :: Value -> Value -> Value
      fallbackConfig = flip insertConfig

      optionalConfig = filterEssentialConfig - toJSON defaultConfig

      _maybeConfig =  -- trace' "JSON: "
                      _v
                      >>= decode
                          . encode
                          . fallbackConfig optionalConfig
                          . insertParams (someOptions ^. O.params)
                          . toParsableConfig

  case _maybeConfig of
    Nothing -> do
      let _r =
            execWriter - do
              tell "\n"
              case _maybeFilePath of
                Just _filePath -> do
                                    tell "Failed to parse configuration file: "
                                    tell _filePath
                                    tell "\n"
                                    tell "Example: \n"
                                    tell - showConfig defaultConfig <> "\n"
                Nothing -> do
                            tell "The password argument '-k' is required.\n"
                            tell "Alternatively, use '-c' to provide a "
                            tell "configuration file.\n"
                            tell "\n"
                            tell "Use '-h' to show help text"

              tell "\n"

      throwError - _r ^. _Text

    Just _config -> do
      let configStr = showConfig _config ^. _Text :: String
      io - debug_ - "Using config: " <> configStr
      pure - _config