xnoe/elm-header-modification-extension
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Initial Commit

Browse Source
This commit is contained in:
Xnoe 2023-06-25 11:08:38 +01:00
commit 62e7f5e6d2
Signed by: xnoe
GPG Key ID: 45AC398F44F0DAFE
10 changed files with 766 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored Normal file
View File

@ -0,0 +1,2 @@
elm-stuff/
build/

32
Makefile Normal file
View File

@ -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

9
app.html Normal file
View File

@ -0,0 +1,9 @@
<!DOCTYPE HTML>
<html>
<head>
<meta charset="UTF-8">
<script src="foreground.js"></script>
</head>
<body>
</body>
</html>

13
app.js Normal file
View File

@ -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("");
});
});

57
background.js Normal file
View File

@ -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: ["<all_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: ["<all_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);
});

26
elm.json Normal file
View File

@ -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": {}
}
}

21
manifest.json Normal file
View File

@ -0,0 +1,21 @@
{
"manifest_version": 2,
"name": "Request Manipulator",
"version": "1.0",
"description": "Allows manipulating requests",
"permissions": [
"webRequest",
"webRequestBlocking",
"<all_urls>"
],
"background": {
"scripts": ["background.js"]
},
"browser_action": {
"default_title": "Request Manipulator"
}
}

205
src/Background/Background.elm Normal file
View File

@ -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
]
}

37
src/Common.elm Normal file
View File

@ -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))))

364
src/Foreground/App.elm Normal file
View File

@ -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]
}