From 62e7f5e6d2852da691cf0ee9e04f1bb5132f7296 Mon Sep 17 00:00:00 2001 From: Xnoe Date: Sun, 25 Jun 2023 11:08:38 +0100 Subject: [PATCH] Initial Commit --- .gitignore | 2 + Makefile | 32 +++ app.html | 9 + app.js | 13 ++ background.js | 57 ++++++ elm.json | 26 +++ manifest.json | 21 ++ src/Background/Background.elm | 205 +++++++++++++++++++ src/Common.elm | 37 ++++ src/Foreground/App.elm | 364 ++++++++++++++++++++++++++++++++++ 10 files changed, 766 insertions(+) create mode 100644 .gitignore create mode 100644 Makefile create mode 100644 app.html create mode 100644 app.js create mode 100644 background.js create mode 100644 elm.json create mode 100644 manifest.json create mode 100644 src/Background/Background.elm create mode 100644 src/Common.elm create mode 100644 src/Foreground/App.elm diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..e88fd58 --- /dev/null +++ b/.gitignore @@ -0,0 +1,2 @@ +elm-stuff/ +build/ \ No newline at end of file diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..046be6f --- /dev/null +++ b/Makefile @@ -0,0 +1,32 @@ +BACKGROUND_ELM_FILES=$(shell find src/Background/ -name '*.elm') +FOREGROUND_ELM_FILES=$(shell find src/Foreground/ -name '*.elm') +BACKGROUND_JS_FILES=$(patsubst src/%.elm,build/%.js,$(BACKGROUND_ELM_FILES)) +FOREGROUND_JS_FILES=$(patsubst src/%.elm,build/%.js,$(FOREGROUND_ELM_FILES)) + +DEPENDS_BACKGROUND := background.js +DEPENDS_FOREGROUND := app.js +DEPENDS := build/background.js build/foreground.js +COPY := manifest.json app.html + +package: all + cd build && zip -FS extension.xpi * + +all: clean prepare $(COPY) $(DEPENDS) + cp $(COPY) build + +build/foreground.js: $(FOREGROUND_JS_FILES) $(DEPENDS_FOREGROUND) + cat $^ > $@ + +build/background.js: $(BACKGROUND_JS_FILES) $(DEPENDS_BACKGROUND) + cat $^ > $@ + +build/%.js: src/%.elm + elm make --optimize $^ --output=$@ + +clean: + [ -e build ] && rm -r build || /bin/true + +prepare: + [ ! -e build ] && mkdir build || /bin/true + +.PHONY: package all clean prepare \ No newline at end of file diff --git a/app.html b/app.html new file mode 100644 index 0000000..ab64e31 --- /dev/null +++ b/app.html @@ -0,0 +1,9 @@ + + + + + + + + + \ No newline at end of file diff --git a/app.js b/app.js new file mode 100644 index 0000000..901e1e6 --- /dev/null +++ b/app.js @@ -0,0 +1,13 @@ +let app; +document.addEventListener("DOMContentLoaded", () => { + app = Elm.Foreground.App.init(); + + app.ports.consoleLog.subscribe(message => console.log(message)); + + app.ports.localStorageGet.subscribe(key => app.ports.localStorageRecv.send([key, window.localStorage.getItem(key) ?? "{}"])); + + app.ports.localStorageSet?.subscribe(([key, value]) => { + window.localStorage.setItem(key, value); + browser.runtime.sendMessage(""); + }); +}); \ No newline at end of file diff --git a/background.js b/background.js new file mode 100644 index 0000000..d4a4d2f --- /dev/null +++ b/background.js @@ -0,0 +1,57 @@ +let app = Elm.Background.Background.init(); + +app.ports.consoleLog.subscribe(message => console.log(message)); + +app.ports.localStorageGet.subscribe(key => app.ports.localStorageRecv.send([key, window.localStorage.getItem(key) ?? "{}"])); + +let requestResolveMap = {}; +let responseResolveMap = {}; + +browser.webRequest.onBeforeSendHeaders.addListener( + requestDetails => { + let resolve; + let p = new Promise((r, _) => resolve = r); + + requestResolveMap[requestDetails.requestId] = resolve; + app.ports.incomingRequest.send([requestDetails.requestId, JSON.stringify(requestDetails)]); + + return p; + }, + {urls: [""]}, + ["blocking", "requestHeaders"] +); + +browser.webRequest.onHeadersReceived.addListener( + responseDetails => { + let resolve; + let p = new Promise((r, _) => resolve = r); + + responseResolveMap[responseDetails.requestId] = resolve; + app.ports.incomingResponse.send([responseDetails.requestId, JSON.stringify(responseDetails)]); + + return p; + }, + {urls: [""]}, + ["blocking", "responseHeaders"] +); + +app.ports.modifyRequest.subscribe(([id, body]) => { + requestResolveMap[id](body) + delete requestResolveMap[id]; +}); + +app.ports.modifyResponse.subscribe(([id, body]) => { + responseResolveMap[id](body) + delete responseResolveMap[id]; +}); + +browser.runtime.onMessage.addListener(() => app.ports.refresh.send("")); + +browser.browserAction.onClicked.addListener(() => { + let createProperties = { + active: true, + url: "app.html", + }; + + browser.tabs.create(createProperties); +}); \ No newline at end of file diff --git a/elm.json b/elm.json new file mode 100644 index 0000000..a3b44f2 --- /dev/null +++ b/elm.json @@ -0,0 +1,26 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.1", + "dependencies": { + "direct": { + "elm/browser": "1.0.2", + "elm/core": "1.0.5", + "elm/html": "1.0.0", + "elm/json": "1.1.3", + "NoRedInk/elm-json-decode-pipeline": "1.0.1", + "elm/regex": "1.0.0" + }, + "indirect": { + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.3" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} diff --git a/manifest.json b/manifest.json new file mode 100644 index 0000000..f80550b --- /dev/null +++ b/manifest.json @@ -0,0 +1,21 @@ +{ + "manifest_version": 2, + "name": "Request Manipulator", + "version": "1.0", + + "description": "Allows manipulating requests", + + "permissions": [ + "webRequest", + "webRequestBlocking", + "" + ], + + "background": { + "scripts": ["background.js"] + }, + + "browser_action": { + "default_title": "Request Manipulator" + } +} \ No newline at end of file diff --git a/src/Background/Background.elm b/src/Background/Background.elm new file mode 100644 index 0000000..caed73a --- /dev/null +++ b/src/Background/Background.elm @@ -0,0 +1,205 @@ +port module Background.Background exposing (..) + +import Common exposing (..) + +import Platform + +import Json.Encode as E +import Json.Decode as D +import Json.Decode.Pipeline as P +import Regex + +port consoleLog : String -> Cmd msg +port localStorageRecv : ((String, String) -> msg) -> Sub msg + +port incomingRequest : ((String, String) -> msg) -> Sub msg +port modifyRequest : (String, E.Value) -> Cmd msg + +port incomingResponse : ((String, String) -> msg) -> Sub msg +port modifyResponse : (String, E.Value) -> Cmd msg + +port refresh : (String -> msg) -> Sub msg + +type alias Model = + { enabled : Bool + , requestActions : List (Regex.Regex, Action) + , responseActions : List (Regex.Regex, Action) + } + +initial_model : Model +initial_model = + { enabled = False + , requestActions = [] + , responseActions = [] + } + +toModel : PreModel -> Model +toModel pm = + let + try_regex (s, a) = + Maybe.map (\r -> (r, a)) (Regex.fromString ("^" ++ s ++ "$")) + in + { enabled = pm.enabled + , requestActions = List.filterMap try_regex pm.requestActions + , responseActions = List.filterMap try_regex pm.responseActions + } + +init : () -> (Model, Cmd msg) +init _ = + ( initial_model + , localStorageGet "config" + ) + +type Msg + = IncomingRequest (String, String) + | IncomingResponse (String, String) + | LocalStorageRecv (String, String) + | Refresh String + +assocListFind : List (a, b) -> a -> Bool +assocListFind list a = + List.any (\x -> Tuple.first x == a) list + +assocListSet : List (a, b) -> a -> b -> List (a, b) +assocListSet list a b = + List.map (\(l, r) -> if l == a then (l, b) else (l, r)) list + +assocListGetJson : List (Regex.Regex, b) -> String -> List b +assocListGetJson list a = + let + assocListGetJson_i acc list_ = + case list_ of + [] -> acc + ((l,r)::t) -> if Regex.contains l a then assocListGetJson_i (r::acc) t else assocListGetJson_i acc t + in assocListGetJson_i [] list + +type alias HttpHeader = + { name : String + , value : String + } + +httpHeaderDecoder : D.Decoder HttpHeader +httpHeaderDecoder = + D.succeed HttpHeader + |> P.required "name" D.string + |> P.optional "value" D.string "" + +type alias Request = + { incognito : Bool + , method : String + , requestId : String + , timeStamp : Int + , resource_type : String + , url : String + , requestHeaders : List HttpHeader + } + +requestDecoder : D.Decoder Request +requestDecoder = + D.succeed Request + |> P.required "incognito" D.bool + |> P.required "method" D.string + |> P.required "requestId" D.string + |> P.required "timeStamp" D.int + |> P.required "type" D.string + |> P.required "url" D.string + |> P.optional "requestHeaders" (D.list httpHeaderDecoder) [] + +type alias Response = + { incognito : Bool + , method : String + , requestId : String + , timeStamp : Int + , resource_type : String + , url : String + , responseHeaders : List HttpHeader + } + +responseDecoder : D.Decoder Response +responseDecoder = + D.succeed Response + |> P.required "incognito" D.bool + |> P.required "method" D.string + |> P.required "requestId" D.string + |> P.required "timeStamp" D.int + |> P.required "type" D.string + |> P.required "url" D.string + |> P.optional "responseHeaders" (D.list httpHeaderDecoder) [] + +doNothingReq : String -> Cmd msg +doNothingReq id = modifyRequest (id, E.object []) + +doNothingRes : String -> Cmd msg +doNothingRes id = modifyResponse (id, E.object []) + +commandOfActions : Bool -> String -> ((String, E.Value) -> Cmd msg) -> List HttpHeader -> List Action -> Cmd msg +commandOfActions response id makeCmd headers actions = + let + commandOfActions_i headers_ l = + case l of + [] -> makeCmd (id, E.object [(if response then "responseHeaders" else "requestHeaders", E.list (\x -> E.object [("name", E.string x.name), ("value", E.string x.value)]) headers_)]) + (Redirect dest :: _) -> makeCmd (id, E.object [("redirectUrl", E.string dest)]) + (ModifyHeader (h, v) :: t) -> commandOfActions_i (List.map (\p -> if p.name == h then {p | value = v} else p) headers_) t + (AddHeader (h, v) :: t) -> commandOfActions_i ({name = h, value = v} :: headers_) t + (RemoveHeader h :: t) -> commandOfActions_i (List.filterMap (\p -> if p.name == h then Nothing else Just p) headers_) t + in + commandOfActions_i headers actions + +update : Msg -> Model -> (Model, Cmd msg) +update msg model = + case msg of + IncomingRequest (id, req) -> + if model.enabled then + case D.decodeString requestDecoder req of + Ok r -> + let actions = assocListGetJson model.requestActions r.url in + (model, commandOfActions False id modifyRequest r.requestHeaders actions) + Err _ -> (model, doNothingReq id) + else + (model, doNothingReq id) + + IncomingResponse (id, res) -> + if model.enabled then + case D.decodeString responseDecoder res of + Ok r -> + let actions = assocListGetJson model.responseActions r.url in + (model, Cmd.batch [commandOfActions True id modifyResponse r.responseHeaders actions, consoleLog r.url]) + Err _ -> (model, doNothingRes id) + else + (model, doNothingRes id) + + LocalStorageRecv (k, v) -> + case k of + "config" -> + case D.decodeString preModelDecoder v of + Ok m -> + ( m |> toModel + , Cmd.none + ) + + Err _ -> + ( initial_model + , consoleLog v + ) + + _ -> + ( model + , Cmd.none + ) + + Refresh _ -> + ( model + , localStorageGet "config" + ) + +main : Program () Model Msg +main = Platform.worker + { init = init + , update = update + , subscriptions = \_ -> Sub.batch + [ incomingRequest IncomingRequest + , incomingResponse IncomingResponse + , localStorageRecv LocalStorageRecv + , refresh Refresh + ] + } \ No newline at end of file diff --git a/src/Common.elm b/src/Common.elm new file mode 100644 index 0000000..0de1c1d --- /dev/null +++ b/src/Common.elm @@ -0,0 +1,37 @@ +port module Common exposing (..) + +import Json.Decode as D + +port localStorageGet : String -> Cmd msg + +type Action + = Redirect String + | ModifyHeader (String, String) + | AddHeader (String, String) + | RemoveHeader String + +actionDecoder : D.Decoder Action +actionDecoder = + D.field "type" D.string + |> D.andThen + (\actionType -> + case actionType of + "redirect" -> D.map Redirect (D.field "destination" D.string) + "modify" -> D.map2 (\a b -> ModifyHeader (a,b)) (D.field "header" D.string) (D.field "value" D.string) + "add" -> D.map2 (\a b -> AddHeader (a,b)) (D.field "header" D.string) (D.field "value" D.string) + "remove" -> D.map RemoveHeader (D.field "header" D.string) + _ -> D.fail "Failed to decode action" + ) + +type alias PreModel = + { enabled : Bool + , requestActions : List (String, Action) + , responseActions : List (String, Action) + } + +preModelDecoder : D.Decoder PreModel +preModelDecoder = + D.map3 PreModel + (D.field "enabled" D.bool) + (D.field "request_actions" (D.list (D.map2 (\a b -> (a, b)) (D.field "target" D.string) (D.field "action" actionDecoder)))) + (D.field "response_actions" (D.list (D.map2 (\a b -> (a, b)) (D.field "target" D.string) (D.field "action" actionDecoder)))) \ No newline at end of file diff --git a/src/Foreground/App.elm b/src/Foreground/App.elm new file mode 100644 index 0000000..ac8260e --- /dev/null +++ b/src/Foreground/App.elm @@ -0,0 +1,364 @@ +port module Foreground.App exposing (..) + +import Common exposing (..) + +import Browser exposing (Document) +import Json.Decode as D +import Json.Encode as E +import Html exposing (Html) +import Html.Attributes exposing (action) +import Html.Events exposing (onInput) +import Html.Events exposing (onClick) +import Background.Background exposing (Request) + +port localStorageSet : (String, String) -> Cmd msg + +port localStorageRecv : ((String, String) -> msg) -> Sub msg +port consoleLog : String -> Cmd msg + +type Type + = Request + | Response + +type Msg + = LocalStorageRecv (String, String) + | TypeSelectChanged (Type, Int, String) + | UpdateTarget (Type, Int, String) + | UpdateV1 (Type, Int, String) + | UpdateV2 (Type, Int, String) + | RemoveRule (Type, Int) + | AddRule Type + | Save + | Toggle + +valueOfAction : Action -> String +valueOfAction action = + case action of + Redirect _ -> "redirect" + AddHeader _ -> "add" + ModifyHeader _ -> "modify" + RemoveHeader _ -> "remove" + +type ActionType + = RedirectT + | AddT + | ModifyT + | RemoveT + +stringOfActionType : ActionType -> String +stringOfActionType a = + case a of + RedirectT -> "Redirect" + AddT -> "Add Header" + ModifyT -> "Modify Header" + RemoveT -> "Remove Header" + +valueOfActionType : ActionType -> String +valueOfActionType a = + case a of + RedirectT -> "redirect" + AddT -> "add" + ModifyT -> "modify" + RemoveT -> "remove" + +actionTypeOfValue : String -> Maybe ActionType +actionTypeOfValue v = + case v of + "redirect" -> Just RedirectT + "add" -> Just AddT + "modify" -> Just ModifyT + "remove" -> Just RemoveT + _ -> Nothing + +viewOfEntry : Type -> Int -> (String, Action) -> Html Msg +viewOfEntry t index (url, action) = + Html.div + [] + ( + [ Html.text "Target: " + , Html.input [Html.Attributes.value url, onInput (\a -> UpdateTarget (t, index, a))] [] + , let + valid_values = + if t == Request then + [RedirectT, AddT, ModifyT, RedirectT] + else + [AddT, ModifyT, RedirectT] + options = + valid_values + |> List.map (\v -> Html.option [Html.Attributes.value <| valueOfActionType v, Html.Attributes.selected (valueOfAction action == valueOfActionType v)] [Html.text <| stringOfActionType v]) + in + Html.select [onInput (\a -> TypeSelectChanged (t, index, a))] options + ] + ++ + ( + case action of + Redirect d -> + [ Html.text "Destination: " + , Html.input [Html.Attributes.value d, onInput (\a -> UpdateV1 (t, index, a))] [] + ] + AddHeader (h,v) -> + [ Html.text "Header Name: " + , Html.input [Html.Attributes.value h, onInput (\a -> UpdateV1 (t, index, a))] [] + , Html.text "Header Value: " + , Html.input [Html.Attributes.value v, onInput (\a -> UpdateV2 (t, index, a))] [] + ] + ModifyHeader (h,v) -> + [ Html.text "Header Name: " + , Html.input [Html.Attributes.value h, onInput (\a -> UpdateV1 (t, index, a))] [] + , Html.text "Header Value: " + , Html.input [Html.Attributes.value v, onInput (\a -> UpdateV2 (t, index, a))] [] + ] + RemoveHeader h -> + [ Html.text "Header Name: " + , Html.input [Html.Attributes.value h, onInput (\a -> UpdateV1 (t, index, a))] [] + ] + ) + ++ + [ Html.button [onClick (RemoveRule (t, index))] [Html.text "x"] + ] + ) + +type alias Model = + { enabled : Bool + , requestActions : List (String, Action) + , responseActions : List (String, Action) + } + +encodeAction : Action -> E.Value +encodeAction a = + case a of + Redirect d -> E.object + [ ("type", E.string "redirect") + , ("destination", E.string d) + ] + ModifyHeader (h,v) -> E.object + [ ("type", E.string "modify") + , ("header", E.string h) + , ("value", E.string v) + ] + AddHeader (h,v) -> E.object + [ ("type", E.string "add") + , ("header", E.string h) + , ("value", E.string v) + ] + RemoveHeader h -> E.object + [ ("type", E.string "remove") + , ("header", E.string h) + ] + +encodeRule : (String, Action) -> E.Value +encodeRule (t, a) = + E.object + [ ("target", E.string t) + , ("action", encodeAction a) + ] + +encodeModel : Model -> E.Value +encodeModel model = + E.object + [ ("enabled", E.bool model.enabled) + , ("request_actions", E.list encodeRule model.requestActions) + , ("response_actions", E.list encodeRule model.responseActions) + ] + +initial_model : Model +initial_model = + { enabled = False + , requestActions = [] + , responseActions = [] + } + +toModel : PreModel -> Model +toModel pm = pm + +init : () -> (Model, Cmd msg) +init _ = + ( initial_model + , localStorageGet "config" + ) + +view : Model -> Document Msg +view model = + { title = "Elm Header Modification Extension" + , body = + [ Html.button [onClick Toggle] [Html.text <| if model.enabled then "Disable" else "Enable"] + , Html.button [onClick Save] [Html.text "Save"] + , Html.h3 [] [Html.text "Request Rules"] + , Html.div [] (model.requestActions |> (List.indexedMap <| viewOfEntry Request)) + , Html.button [onClick <| AddRule Request] [Html.text "+"] + , Html.h3 [] [Html.text "Response Rules"] + , Html.div [] (model.responseActions |> (List.indexedMap <| viewOfEntry Response)) + , Html.button [onClick <| AddRule Response] [Html.text "+"] + ] + } + +replaceAction : Type -> Int -> Action -> Model -> Model +replaceAction t index v model = + case t of + Request -> {model | requestActions = model.requestActions |> List.indexedMap (\index_ ((url,_) as e)-> if index_ == index then (url,v) else e)} + Response -> {model | responseActions = model.responseActions |> List.indexedMap (\index_ ((url,_) as e)-> if index_ == index then (url,v) else e)} + +update : Msg -> Model -> (Model, Cmd msg) +update msg model = + case msg of + LocalStorageRecv (k, v) -> + case k of + "config" -> + case D.decodeString preModelDecoder v of + Ok m -> + ( m |> toModel + , Cmd.none + ) + + Err _ -> + ( initial_model + , consoleLog "Failed to decode config!" + ) + + _ -> + ( model + , Cmd.none + ) + + TypeSelectChanged (t, index, kind) -> + let + handleChange a = case a of + RedirectT -> + if t == Request then + replaceAction t index (Redirect "") model + else + model + AddT -> replaceAction t index (AddHeader ("", "")) model + ModifyT -> replaceAction t index (ModifyHeader ("", "")) model + RemoveT -> replaceAction t index (RemoveHeader "") model + in + ( Maybe.map handleChange (actionTypeOfValue kind) |> Maybe.withDefault model + , Cmd.none + ) + + UpdateTarget (t, index, v) -> + let + updateTarget = List.indexedMap + ( + \i ((_,b) as e) -> + if i == index then + (v, b) + else + e + ) + in + ( case t of + Request -> + { model | + requestActions = model.requestActions |> updateTarget + } + Response -> + { model | + responseActions = model.responseActions |> updateTarget + } + , Cmd.none + ) + + UpdateV1 (t, index, v) -> + let + updateV1 = List.indexedMap + ( + \index_ ((url,action) as entry) -> + if index_ == index then + case action of + Redirect _ -> (url, Redirect v) + AddHeader (_, r) -> (url, AddHeader (v, r)) + ModifyHeader (_, r) -> (url, ModifyHeader (v, r)) + RemoveHeader _ -> (url, RemoveHeader v) + else + entry + ) + in + ( case t of + Request -> + { model | + requestActions = model.requestActions |> updateV1 + } + Response -> + { model | + responseActions = model.responseActions |> updateV1 + } + , Cmd.none + ) + + UpdateV2 (t, index, v) -> + let + updateV2 = List.indexedMap + ( + \index_ ((url,action) as entry) -> + if index_ == index then + case action of + AddHeader (l, _) -> (url, AddHeader (l, v)) + ModifyHeader (l, _) -> (url, ModifyHeader (l, v)) + _ -> entry + else + entry + ) + in + ( case t of + Request -> + { model | + requestActions = model.requestActions |> updateV2 + } + Response -> + { model | + responseActions = model.responseActions |> updateV2 + } + , Cmd.none + ) + + RemoveRule (t, index) -> + ( case t of + Request -> + { model | + requestActions = model.requestActions |> List.indexedMap (\i e -> if i == index then Nothing else Just e) |> List.filterMap identity + } + Response -> + { model | + responseActions = model.responseActions |> List.indexedMap (\i e -> if i == index then Nothing else Just e) |> List.filterMap identity + } + , Cmd.none + ) + + AddRule t -> + ( case t of + Request -> + { model | + requestActions = model.requestActions ++ [("", Redirect "")] + } + Response -> + { model | + responseActions = model.responseActions ++ [("", AddHeader ("", ""))] + } + , Cmd.none + ) + + Save -> + ( model + , localStorageSet ("config", E.encode 0 <| encodeModel model) + ) + + Toggle -> + let + new_model = + { model | + enabled = not model.enabled + } + in + ( new_model + , localStorageSet ("config", E.encode 0 <| encodeModel new_model) + ) + +main : Program () Model Msg +main = Browser.document + { init = init + , view = view + , update = update + , subscriptions = \_ -> Sub.batch + [localStorageRecv LocalStorageRecv] + }