<commit_before>{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
module Rede.Research.ResearchWorker(
    runResearchWorker
    ,spawnHarServer
    ) where 


import           Control.Lens                    ((^.))
import qualified Control.Lens                    as L
-- import           Control.Exception              (catch)
import           Control.Concurrent              (forkIO, threadDelay)
import           Control.Concurrent.Chan
import           Control.Concurrent.MVar
import           Control.Monad.Catch             (catch)

import qualified Data.ByteString                 as B
import           Data.ByteString.Char8           (pack, unpack)
import qualified Data.ByteString.Lazy            as LB
import           Data.Conduit
import           Data.Foldable                   (foldMap)
import           Data.Monoid                     (mappend)
import qualified Data.Monoid                     as M
-- import qualified Data.ByteString.Lazy           as LB
import qualified Data.ByteString.Builder         as Bu

import           Control.Monad.IO.Class
import           Control.Monad.Trans.Reader      (ReaderT (..), runReaderT)
import           System.Directory
import           System.FilePath
import           System.IO
import           System.Process

import qualified Network.URI                     as U

import           System.Log.Logger
import           Text.Printf                     (printf)

import           Rede.Workers.ResponseFragments  (RequestMethod (..),
                                                  getMethodFromHeaders,
                                                  getUrlFromHeaders,
                                                  simpleResponse)

import           Rede.HarFiles.DnsMasq           (dnsMasqFileContentsToIp)
-- import           Rede.HarFiles.JSONDataStructure (originUrl)
import           Rede.HarFiles.ServedEntry       (BadHarFile (..),
                                                  ResolveCenter, allSeenHosts,
                                                  rcName, resolveCenterFromLazyByteString,
                                                  rcOriginalUrl
                                                  )
import           Rede.Http2.MakeAttendant        (http2Attendant)
import           Rede.MainLoop.CoherentWorker
import           Rede.MainLoop.ConfigHelp        (configDir, getInterfaceName,
                                                  getMimicPort)
import           Rede.MainLoop.OpenSSL_TLS       (FinishRequest (..), tlsServeWithALPNAndFinishOnRequest)
import           Rede.Utils.ConcatConduit        (concatConduit)
import           Rede.Utils.PrintfArgByteString  ()
import           Rede.Workers.HarWorker          (harCoherentWorker)





data ServiceState = ServiceState {
    -- Put one here, let it run through the pipeline...
    _nextHarvestUrl :: Chan B.ByteString

    -- To be passed on to StationB
    ,_nextTestUrl :: Chan B.ByteString

    -- Files to be handed out to DNSMasq
    , _nextDNSMasqFile :: Chan B.ByteString

    , _resolveCenterChan :: Chan ResolveCenter

    , _finishRequestChan :: Chan FinishRequest

    , _researchDir :: FilePath 

    -- The IP address that StationB needs to connect
    , _useAddressForStationB :: B.ByteString

    -- This one we use in the opposite sense: we write here...
    -- ,_servingHar    :: Chan (ResolveCenter, OriginUrl )
    }

L.makeLenses ''ServiceState


type ServiceStateMonad = ReaderT ServiceState IO


runResearchWorker :: 
    Chan B.ByteString 
    -> Chan ResolveCenter 
    -> Chan FinishRequest 
    -> FilePath
    -> B.ByteString
    -> IO CoherentWorker
runResearchWorker url_chan resolve_center_chan finish_request_chan research_dir use_address_for_station_b = do 
    liftIO $ infoM "ResearchWorker" "Starting research worker"
    next_test_url_chan <- newChan 
    next_dns_masq_file <- newChan

    let     
        state = ServiceState {
             _nextHarvestUrl = url_chan
            ,_nextTestUrl    = next_test_url_chan
            ,_nextDNSMasqFile = next_dns_masq_file
            ,_resolveCenterChan = resolve_center_chan
            ,_finishRequestChan = finish_request_chan
            ,_researchDir = research_dir
            ,_useAddressForStationB = use_address_for_station_b
            }
    return $ \request -> runReaderT (researchWorkerComp request) state


researchWorkerComp :: Request -> ServiceStateMonad PrincipalStream
researchWorkerComp (input_headers, maybe_source) = do 
    next_harvest_url    <- L.view nextHarvestUrl
    next_dnsmasq_chan   <- L.view nextDNSMasqFile
    next_test_url_chan  <- L.view nextTestUrl
    resolve_center_chan <- L.view resolveCenterChan 
    finish_chan         <- L.view finishRequestChan 
    base_research_dir   <- L.view researchDir
    use_address_for_station_b <- L.view useAddressForStationB

    let 
        method = getMethodFromHeaders input_headers
        req_url  = getUrlFromHeaders input_headers

    case method of 

        -- Most requests are served by POST to emphasize that a request changes 
        -- the state of this program... 
        Post_RM 
            | req_url == "/nexturl/" -> do 
                -- Starts harvesting of a resource
                liftIO $ infoM "ResearchWorker" "..  /nexturl/"
                url <- liftIO $ readChan next_harvest_url
                return $ simpleResponse 200 url 

            | req_url == "/testurl/" -> do 
                -- Sends the next test url to the Chrome extension, this starts processing by 
                -- StationB
                liftIO $ infoM "ResearchWorker" "..  /testurl/"
                url <- liftIO $ readChan next_test_url_chan
                -- Okej, got the thing, but I' need to be sure that there has been enough time to 
                -- apply the new network settings in StationB 
                liftIO $ threadDelay 4000000 -- <-- 4 seconds
                return $ simpleResponse 200 url

            | req_url == "/har/", Just source <- maybe_source -> do
                -- Receives a .har object from the harvest station ("StationA"), and 
                -- makes all the arrangements for it to be tested using HTTP 2
                liftIO $ infoM "ResearchWorker" "..  /har/"
                catch 
                    (do
                        (resolve_center, har_file_contents) <- liftIO $ output_computation source
                        let 
                            test_url = resolve_center ^. rcOriginalUrl
                            use_text = "Response processed"<commit_msg>Improve inline documentation at ResearchWorker.hs<commit_after>{-# LANGUAGE OverloadedStrings, TemplateHaskell #-}
module Rede.Research.ResearchWorker(
    runResearchWorker
    ,spawnHarServer
    ) where 


import           Control.Lens                    ((^.))
import qualified Control.Lens                    as L
-- import           Control.Exception              (catch)
import           Control.Concurrent              (forkIO, threadDelay)
import           Control.Concurrent.Chan
import           Control.Concurrent.MVar
import           Control.Monad.Catch             (catch)

import qualified Data.ByteString                 as B
import           Data.ByteString.Char8           (pack, unpack)
import qualified Data.ByteString.Lazy            as LB
import           Data.Conduit
import           Data.Foldable                   (foldMap)
import           Data.Monoid                     (mappend)
import qualified Data.Monoid                     as M
-- import qualified Data.ByteString.Lazy           as LB
import qualified Data.ByteString.Builder         as Bu

import           Control.Monad.IO.Class
import           Control.Monad.Trans.Reader      (ReaderT (..), runReaderT)
import           System.Directory
import           System.FilePath
import           System.IO
import           System.Process

import qualified Network.URI                     as U

import           System.Log.Logger
import           Text.Printf                     (printf)

import           Rede.Workers.ResponseFragments  (RequestMethod (..),
                                                  getMethodFromHeaders,
                                                  getUrlFromHeaders,
                                                  simpleResponse)

import           Rede.HarFiles.DnsMasq           (dnsMasqFileContentsToIp)
-- import           Rede.HarFiles.JSONDataStructure (originUrl)
import           Rede.HarFiles.ServedEntry       (BadHarFile (..),
                                                  ResolveCenter, allSeenHosts,
                                                  rcName, resolveCenterFromLazyByteString,
                                                  rcOriginalUrl
                                                  )
import           Rede.Http2.MakeAttendant        (http2Attendant)
import           Rede.MainLoop.CoherentWorker
import           Rede.MainLoop.ConfigHelp        (configDir, getInterfaceName,
                                                  getMimicPort)
import           Rede.MainLoop.OpenSSL_TLS       (FinishRequest (..), tlsServeWithALPNAndFinishOnRequest)
import           Rede.Utils.ConcatConduit        (concatConduit)
import           Rede.Utils.PrintfArgByteString  ()
import           Rede.Workers.HarWorker          (harCoherentWorker)





data ServiceState = ServiceState {
    -- Put one here, let it run through the pipeline...
    _nextHarvestUrl :: Chan B.ByteString

    -- To be passed on to StationB
    ,_nextTestUrl :: Chan B.ByteString

    -- Files to be handed out to DNSMasq
    , _nextDNSMasqFile :: Chan B.ByteString

    , _resolveCenterChan :: Chan ResolveCenter

    , _finishRequestChan :: Chan FinishRequest

    , _researchDir :: FilePath 

    -- The IP address that StationB needs to connect
    , _useAddressForStationB :: B.ByteString

    -- This one we use in the opposite sense: we write here...
    -- ,_servingHar    :: Chan (ResolveCenter, OriginUrl )
    }

L.makeLenses ''ServiceState


type ServiceStateMonad = ReaderT ServiceState IO


runResearchWorker :: 
    Chan B.ByteString 
    -> Chan ResolveCenter 
    -> Chan FinishRequest 
    -> FilePath
    -> B.ByteString
    -> IO CoherentWorker
runResearchWorker url_chan resolve_center_chan finish_request_chan research_dir use_address_for_station_b = do 
    liftIO $ infoM "ResearchWorker" "Starting research worker"
    next_test_url_chan <- newChan 
    next_dns_masq_file <- newChan

    let     
        state = ServiceState {
             _nextHarvestUrl = url_chan
            ,_nextTestUrl    = next_test_url_chan
            ,_nextDNSMasqFile = next_dns_masq_file
            ,_resolveCenterChan = resolve_center_chan
            ,_finishRequestChan = finish_request_chan
            ,_researchDir = research_dir
            ,_useAddressForStationB = use_address_for_station_b
            }
    return $ \request -> runReaderT (researchWorkerComp request) state


researchWorkerComp :: Request -> ServiceStateMonad PrincipalStream
researchWorkerComp (input_headers, maybe_source) = do 
    next_harvest_url    <- L.view nextHarvestUrl
    next_dnsmasq_chan   <- L.view nextDNSMasqFile
    next_test_url_chan  <- L.view nextTestUrl
    resolve_center_chan <- L.view resolveCenterChan 
    finish_chan         <- L.view finishRequestChan 
    base_research_dir   <- L.view researchDir
    use_address_for_station_b <- L.view useAddressForStationB

    let 
        method = getMethodFromHeaders input_headers
        req_url  = getUrlFromHeaders input_headers

    case method of 

        -- Most requests are served by POST to emphasize that a request changes 
        -- the state of this program... 
        Post_RM 
            | req_url == "/nexturl/" -> do 
                -- Starts harvesting of a resource... this request is made by StationA
                liftIO $ infoM "ResearchWorker" "..  /nexturl/"
                url <- liftIO $ readChan next_harvest_url
                return $ simpleResponse 200 url 

            | req_url == "/testurl/" -> do 
                -- Sends the next test url to the Chrome extension, this starts processing by 
                -- StationB... the request is started by StationB
                liftIO $ infoM "ResearchWorker" "..  /testurl/"
                url <- liftIO $ readChan next_test_url_chan
                -- Okej, got the thing, but I' need to be sure that there has been enough time to 
                -- apply the new network settings in StationB 
                liftIO $ threadDelay 4000000 -- <-- 4 seconds
                return $ simpleResponse 200 url

            | req_url == "/har/", Just source <- maybe_source -> do
                -- Receives a .har object from the harvest station ("StationA"), and 
                -- makes all the arrangements for it to be tested using HTTP 2
                liftIO $ infoM "ResearchWorker" "..  /har/"
                catch 
                    (do
                        (resolve_center, har_file_contents) <- liftIO $ output_computation source
                        let 
                            test_url = resolve_center ^. rcOriginalUrl
                            use_text = "Response processed"
{'fraction_non_alphanumeric': 0.06114890400604686, 'fraction_numerical': 0.0027210884353741495, 'mean_word_length': 1.631463802704853, 'pattern_counts': {'":': 0, '<': 31, '<?xml version=': 0, '>': 23, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 32, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5986294', 'n_tokens_mistral': 3498, 'n_tokens_neox': 3178, 'n_words': 893}