commit 62e7f5e6d2852da691cf0ee9e04f1bb5132f7296 Author: Xnoe Date: Sun Jun 25 11:08:38 2023 +0100 Initial Commit 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] + }