inspection-proxy-0.1.0.3: Main.hs

module Main where


    import Control.Monad (void, unless, when, forever)
    import Data.Maybe (isNothing)
    import Control.Concurrent.Async (async)
    import qualified Data.ByteString.Char8 as B
    import Pipes
    import Pipes.Network.TCP
    import System.Console.CmdArgs.Explicit


    arguments :: Mode [(String,String)]
    arguments = mode "inspection-proxy" [] "" (flagArg (upd "proxy-setup") "proxy-port server port")
        [ flagNone ["only-server"] (("only-server",""):) "print only server response activity"
        , flagNone ["only-client"] (("only-client",""):) "print only client request activity"
        , flagHelpSimple (("help",""):)
        , flagVersion (("version",""):)
        ]
        where upd msg x v = Right $ (msg,x):v

    proxyDetails :: [(String, t)] -> Maybe (t, t, t)
    proxyDetails as = readProxyDetails $ filter (\(a,_) -> a == "proxy-setup") as where
        readProxyDetails as' | length as' /= 3 = Nothing
                             | otherwise       = Just (snd $ as' !! 2, snd $ as' !! 1, snd $ head as')  -- arguments are parsed in reverse order


    printPass :: Bool -> Pipe B.ByteString B.ByteString IO r
    printPass skip = forever $ do
        readValue <- await
        unless skip $ lift $ B.putStrLn readValue
        yield readValue


    main :: IO ()
    main = do
        args <- processArgs arguments 
        let connectionDetails = proxyDetails args
        let hasFlag flag      = (flag, "") `elem` args
        when (hasFlag "version") $ putStrLn "inspection-proxy version 0.1.0.3"
        if hasFlag "help" || isNothing connectionDetails
            then print $ helpText [] HelpFormatDefault arguments
            else do
                let Just (bindport, host, port) = connectionDetails
                serve HostAny bindport $ \(bindSocket, _) -> 
                    connect host port $ \(serviceSocket, _) -> do
                        void $ async $ runEffect $ fromSocket bindSocket 4096 >-> printPass (hasFlag "only-server") >-> toSocket serviceSocket 
                        runEffect $ fromSocket serviceSocket 4096 >-> printPass (hasFlag "only-client") >-> toSocket bindSocket 
                return ()