inspection-proxy-0.1.0.1: Main.hs

module Main where


    import Control.Proxy.TCP
    import Control.Proxy
    import System.Console.CmdArgs.Explicit

    import Control.Monad (void, unless, when)
    import Data.Maybe (isNothing)
    import Control.Concurrent.Async (async)
    import qualified Data.ByteString.Char8 as B


    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 :: Proxy p => Bool -> () -> p () B.ByteString b' B.ByteString IO r
    printPass skip () = runIdentityP $ forever $ do
        readValue <- request ()
        unless skip $ lift $ B.putStrLn readValue
        void $ respond 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.0"
        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 $ runProxy $ socketReadS 4096 bindSocket >-> printPass (hasFlag "only-server") >-> socketWriteD serviceSocket 
                        runProxy $ socketReadS 4096 serviceSocket >-> printPass (hasFlag "only-client") >-> socketWriteD bindSocket 
                return ()