├── .gitignore ├── README.md ├── build-examples.sh ├── build.sh ├── elm.json ├── examples-db └── Person.elm ├── examples ├── .env ├── .env.example ├── HelloClient.elm ├── HelloDBClient.elm ├── HelloDBServer.elm ├── HelloFile.elm ├── HelloWorld.elm └── SecureWorld.elm └── src ├── ContentType.elm ├── Database ├── Postgres.elm └── Sqlite.elm ├── Error.elm ├── File.elm ├── Internal ├── Response.elm └── Server.elm ├── Jwt.elm ├── Logger.elm ├── Response.elm ├── Server.elm ├── Status.elm └── runner.js /.gitignore: -------------------------------------------------------------------------------- 1 | .DS_Store 2 | 3 | elm-stuff 4 | exmaples/**/*.html -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | This was a fun experiment, and I learned a lot from it, especially a lot about [Deno](https://deno.land/). I definitely still love the idea of an Elm like language for back end development. I found breaking out of the handler into nested branches to be really easy to work with. I really love having Elm's type system as it allows me to use types to both describe and limit what's going on, while not being overly complicated like those of TypeScript, Rust, or Haskell; they're, _for me_, a nicely balanced type system. 2 | 3 | In the end though, working inside the sandbox of a JS environment for a server just seems wrong. Most notably I found it interesting that Deno is a layer on top of Rust, with a huge influence from Go. Both of those languages are purpose built for back end work, more specifically Go is written for building servers. Deno (aka Javascript) doesn't have the performance benefits of Go or Rust (per the Deno devs), nor does it have what I would consider to be the better ergonomics of either. This isn't to say "don't use Deno". I've been very happy in my use of it in-place of where I have typically used Node. I would say though that Elm on the back end would most definitely benefit from, as Evan has said before, not compiling to JS. (I can't speak to compiling to C, BEAM, or anything else as I don't know anything about compiling to those.) 4 | 5 | --- 6 | 7 | # elm-server 8 | 9 | Loosely based off of [ianmackenzie/elm-script](https://github.com/ianmackenzie/elm-script), [F#'s giraffe](https://github.com/giraffe-fsharp/Giraffe), and [Haskell's Servant](https://www.servant.dev/). 10 | 11 | ## WARNING THIS IS JUST FOR FUN NOT FOR PRODUCTION 12 | 13 | ## Basic Example: 14 | 15 | ```Elm 16 | module HelloWorld exposing (main) 17 | 18 | import Error 19 | import Logger as Log 20 | import Response 21 | import Server exposing (Config, Flags, Request, Response) 22 | 23 | 24 | main : Server.Program 25 | main = 26 | Server.program 27 | { init = init 28 | , handler = handler 29 | } 30 | 31 | 32 | init : Flags -> Config 33 | init _ = 34 | Server.baseConfig 35 | 36 | 37 | handler : Request -> Response 38 | handler request = 39 | case Server.getPath request of 40 | [] -> 41 | Response.ok 42 | |> Response.setBody "Hello, Elm Server!" 43 | |> Server.respond request 44 | |> Server.andThen (\_ -> Log.toConsole "index page requested") 45 | 46 | [ "hello", name ] -> 47 | Log.toConsole ("Saying hello to " ++ name) 48 | |> Server.andThen 49 | (\_ -> 50 | Response.ok 51 | |> Response.setBody ("Hello, " ++ name ++ "!") 52 | |> Server.respond request 53 | ) 54 | 55 | _ -> 56 | Server.respond request Response.notFound 57 | ``` 58 | 59 | ## Other Examples: 60 | 61 | - [Hello World](./examples/HelloWorld.elm) 62 | - Your most basic examples 63 | - [HTTPS](./examples/SecureWorld.elm) (You'll need to create your own certs if you want to try this one out.) 64 | - Extension of Hello World to show HTTPS 65 | - [Load a file](./examples/HelloFile.elm), pairs with [HelloClient.elm](./examples/HelloClient.elm) 66 | - Shows loading a file from a local directory and returning the contents to the user 67 | - [Database (Postgres)](./examples/HelloDBServer.elm), pairs with [Person.elm](./examples-db/Person.elm) and [HelloDBClient.elm](./examples/HelloDBClient.elm) 68 | - A simple client and server written in Elm. Only supports basic GET, POST, DELETE 69 | - Shows off sharing code between front and back end 70 | 71 | All examples (listed and otherwise) can be found in [examples](./examples). 72 | 73 | ## Try it out: 74 | 75 | 1. clone this repo 76 | 1. install [Deno](https://deno.land/) 77 | 1. from the cloned repo run `./build.sh` 78 | - this compiles the js glue code which creates a command called `elm-server` 79 | 1. run `elm-server start path/to/YourServer.elm` 80 | - this starts your server 81 | 82 | ## Docs: 83 | 84 | Too unstable to start writing docs. 85 | -------------------------------------------------------------------------------- /build-examples.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | elm make examples/HelloClient.elm --output=examples/hello.html 4 | elm make examples/HelloDBClient.elm --output=examples/hello-db-client.html -------------------------------------------------------------------------------- /build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | deno install -A -f -n elm-server ./src/runner.js -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src", 5 | "examples", 6 | "examples-db" 7 | ], 8 | "elm-version": "0.19.1", 9 | "dependencies": { 10 | "direct": { 11 | "elm/browser": "1.0.2", 12 | "elm/core": "1.0.5", 13 | "elm/html": "1.0.0", 14 | "elm/http": "2.0.0", 15 | "elm/json": "1.1.3", 16 | "elm-community/result-extra": "2.4.0", 17 | "elm-community/string-extra": "4.0.1", 18 | "mdgriffith/elm-ui": "1.1.8", 19 | "zwilias/elm-html-string": "2.0.2" 20 | }, 21 | "indirect": { 22 | "NoRedInk/elm-string-conversions": "1.0.1", 23 | "elm/bytes": "1.0.8", 24 | "elm/file": "1.0.5", 25 | "elm/regex": "1.0.0", 26 | "elm/time": "1.0.0", 27 | "elm/url": "1.0.0", 28 | "elm/virtual-dom": "1.0.2" 29 | } 30 | }, 31 | "test-dependencies": { 32 | "direct": {}, 33 | "indirect": {} 34 | } 35 | } 36 | -------------------------------------------------------------------------------- /examples-db/Person.elm: -------------------------------------------------------------------------------- 1 | module Person exposing 2 | ( PartialPerson 3 | , Person 4 | , decode 5 | , decodeMany 6 | , encode 7 | , getAge 8 | , getId 9 | , getName 10 | , handler 11 | , new 12 | ) 13 | 14 | import Database.Postgres exposing (WhereCondition(..)) 15 | import Error 16 | import Http exposing (Response) 17 | import Json.Decode exposing (Decoder) 18 | import Json.Encode exposing (Value) 19 | import Response 20 | import Result.Extra 21 | import Server exposing (Method(..), Path, Request, Response) 22 | 23 | 24 | tableName : String 25 | tableName = 26 | "persons" 27 | 28 | 29 | create : PartialPerson -> Response 30 | create (PartialPerson _ { name, age }) = 31 | if String.isEmpty name then 32 | Server.resultToResponse (Err "Must have a name") 33 | 34 | else if age < 0 then 35 | Server.resultToResponse (Err "Age must be a positive number") 36 | 37 | else 38 | { tableName = tableName 39 | , columnValues = [ Database.Postgres.wrapString name, String.fromInt age ] 40 | } 41 | |> Database.Postgres.insertQuery 42 | |> Server.query 43 | 44 | 45 | get : WhereCondition -> Response 46 | get where_ = 47 | { tableName = tableName 48 | , where_ = where_ 49 | } 50 | |> Database.Postgres.selectQuery 51 | |> Server.query 52 | |> Server.andThen (reencode >> Server.resultToResponse) 53 | 54 | 55 | delete : Int -> Response 56 | delete id = 57 | { tableName = tableName 58 | , where_ = Equal "id" (String.fromInt id) 59 | } 60 | |> Database.Postgres.deleteQuery 61 | |> Server.query 62 | 63 | 64 | reencode : Value -> Result String Value 65 | reencode value = 66 | Json.Decode.decodeValue decodeSqlMany value 67 | |> Result.map (Json.Encode.list encode) 68 | |> Result.mapError Json.Decode.errorToString 69 | 70 | 71 | decodeSqlMany : Decoder (List Person) 72 | decodeSqlMany = 73 | Json.Decode.list decodeSql 74 | 75 | 76 | decodeSql : Decoder Person 77 | decodeSql = 78 | Json.Decode.map3 (\id name age -> Person { id = id, name = name, age = age }) 79 | (Json.Decode.index 0 Json.Decode.int) 80 | (Json.Decode.index 1 Json.Decode.string) 81 | (Json.Decode.index 2 Json.Decode.int) 82 | 83 | 84 | decodeMany : Decoder (List Person) 85 | decodeMany = 86 | Json.Decode.list decode 87 | 88 | 89 | decode : Decoder Person 90 | decode = 91 | Json.Decode.map3 (\id name age -> Person { id = id, name = name, age = age }) 92 | (Json.Decode.field "id" Json.Decode.int) 93 | (Json.Decode.field "name" Json.Decode.string) 94 | (Json.Decode.field "age" Json.Decode.int) 95 | 96 | 97 | encode : Person -> Value 98 | encode (Person { id, name, age }) = 99 | Json.Encode.object 100 | [ ( "id", Json.Encode.int id ) 101 | , ( "name", Json.Encode.string name ) 102 | , ( "age", Json.Encode.int age ) 103 | ] 104 | 105 | 106 | type alias PersonInternal = 107 | { id : Int 108 | , name : String 109 | , age : Int 110 | } 111 | 112 | 113 | type Person 114 | = Person PersonInternal 115 | 116 | 117 | getName : Person -> String 118 | getName (Person { name }) = 119 | name 120 | 121 | 122 | getAge : Person -> Int 123 | getAge (Person { age }) = 124 | age 125 | 126 | 127 | getId : Person -> Int 128 | getId (Person { id }) = 129 | id 130 | 131 | 132 | type alias PartialPersonInternal = 133 | { name : String 134 | , age : Int 135 | } 136 | 137 | 138 | type PartialPerson 139 | = PartialPerson (List Error) PartialPersonInternal 140 | 141 | 142 | decodePartial : Decoder PartialPerson 143 | decodePartial = 144 | Json.Decode.map2 (\name age -> PartialPerson [] { name = name, age = age }) 145 | (Json.Decode.field "name" Json.Decode.string) 146 | (Json.Decode.field "age" Json.Decode.int) 147 | 148 | 149 | type Error 150 | = NameRequired 151 | | InvalidAge 152 | 153 | 154 | new : PartialPerson 155 | new = 156 | PartialPerson 157 | [] 158 | { name = "" 159 | , age = 0 160 | } 161 | 162 | 163 | handler : Request -> Path -> Response 164 | handler request path = 165 | case ( Server.getMethod request, path ) of 166 | ( Get, [] ) -> 167 | get NoCondition 168 | |> Server.onError (errorResponseHelper request) 169 | |> Server.onSuccess (Response.json >> Server.respond request) 170 | 171 | ( Post, [] ) -> 172 | Json.Decode.decodeValue decodePartial (Server.getBody request) 173 | |> Result.mapError (Json.Decode.errorToString >> Response.error >> Server.respond request) 174 | |> Result.map 175 | (create 176 | >> Server.onError (errorResponseHelper request) 177 | >> Server.onSuccess (Response.json >> Server.respond request) 178 | ) 179 | |> Result.Extra.merge 180 | 181 | ( _, [] ) -> 182 | Server.respond request Response.methodNotAllowed 183 | 184 | ( Delete, [ maybeId ] ) -> 185 | case String.toInt maybeId of 186 | Just id -> 187 | delete id 188 | |> Server.onError (errorResponseHelper request) 189 | |> Server.onSuccess (Response.json >> Server.respond request) 190 | 191 | Nothing -> 192 | Server.respond request (Response.error "Expected a valid id") 193 | 194 | ( _, [ _ ] ) -> 195 | Server.respond request Response.methodNotAllowed 196 | 197 | _ -> 198 | Server.respond request Response.notFound 199 | 200 | 201 | errorResponseHelper : Request -> Error.Error -> Response 202 | errorResponseHelper request = 203 | Error.toString >> Response.error >> Server.respond request 204 | -------------------------------------------------------------------------------- /examples/.env: -------------------------------------------------------------------------------- 1 | PORT=8080 2 | CARL="steve" -------------------------------------------------------------------------------- /examples/.env.example: -------------------------------------------------------------------------------- 1 | PORT=8080 2 | CARL="steve" -------------------------------------------------------------------------------- /examples/HelloClient.elm: -------------------------------------------------------------------------------- 1 | module HelloClient exposing (main) 2 | 3 | import Html exposing (Html, div, h1, p, text) 4 | import Html.Attributes exposing (style) 5 | 6 | 7 | main : Html Never 8 | main = 9 | div 10 | [ style "display" "flex" 11 | , style "flex-direction" "column" 12 | , style "align-items" "center" 13 | ] 14 | [ h1 [] [ text "Sample Elm Client" ] 15 | , p [] 16 | [ text """This is an example of loading and sending some HTML from the server.""" ] 17 | ] 18 | -------------------------------------------------------------------------------- /examples/HelloDBClient.elm: -------------------------------------------------------------------------------- 1 | module HelloDBClient exposing (main) 2 | 3 | import Browser exposing (Document) 4 | import Element exposing (..) 5 | import Element.Font as Font 6 | import Element.Input as Input 7 | import Http exposing (Error(..), Response(..)) 8 | import Json.Encode 9 | import Person exposing (Person) 10 | 11 | 12 | main : Program () Model Msg 13 | main = 14 | Browser.document 15 | { init = init 16 | , view = view 17 | , update = update 18 | , subscriptions = subscriptions 19 | } 20 | 21 | 22 | type alias Model = 23 | { persons : Request (List Person) 24 | } 25 | 26 | 27 | type Request d 28 | = NotYetRequested 29 | | Loading 30 | | Success d 31 | | Failure Http.Error 32 | 33 | 34 | init : () -> ( Model, Cmd Msg ) 35 | init _ = 36 | ( { persons = Loading } 37 | , getPeople 38 | ) 39 | 40 | 41 | getPeople : Cmd Msg 42 | getPeople = 43 | Http.get 44 | { url = "/persons" 45 | , expect = Http.expectJson GotPersons Person.decodeMany 46 | } 47 | 48 | 49 | subscriptions : Model -> Sub Msg 50 | subscriptions model = 51 | Sub.none 52 | 53 | 54 | type Msg 55 | = NoOp 56 | | GotPersons (Result Http.Error (List Person)) 57 | | DeletePerson Person 58 | | PersonDeleted (Result Http.Error Person) 59 | | CreatePerson 60 | | NewPersonAdded (Result Http.Error ()) 61 | 62 | 63 | update : Msg -> Model -> ( Model, Cmd Msg ) 64 | update msg model = 65 | case msg of 66 | NoOp -> 67 | ( model, Cmd.none ) 68 | 69 | GotPersons response -> 70 | case response of 71 | Ok persons -> 72 | ( { model | persons = Success persons }, Cmd.none ) 73 | 74 | Err err -> 75 | ( { model | persons = Failure err }, Cmd.none ) 76 | 77 | DeletePerson person -> 78 | ( model 79 | , Http.request 80 | { method = "DELETE" 81 | , headers = [] 82 | , url = 83 | person 84 | |> Person.getId 85 | |> String.fromInt 86 | |> (++) "/persons/" 87 | , body = Http.emptyBody 88 | , expect = Http.expectWhatever (Result.map (\() -> person) >> PersonDeleted) 89 | , timeout = Nothing 90 | , tracker = Nothing 91 | } 92 | ) 93 | 94 | PersonDeleted response -> 95 | case ( model.persons, response ) of 96 | ( Success persons, Ok deletedPerson ) -> 97 | ( { model 98 | | persons = 99 | persons 100 | |> List.filter (Person.getId >> (/=) (Person.getId deletedPerson)) 101 | |> Success 102 | } 103 | , Cmd.none 104 | ) 105 | 106 | _ -> 107 | ( model, Cmd.none ) 108 | 109 | NewPersonAdded response -> 110 | case response of 111 | Ok () -> 112 | ( { model | persons = Loading }, getPeople ) 113 | 114 | Err _ -> 115 | ( model, Cmd.none ) 116 | 117 | CreatePerson -> 118 | ( model 119 | , Http.post 120 | { url = "/persons" 121 | , body = 122 | [ ( "name", Json.Encode.string "Barl" ) 123 | , ( "age", Json.Encode.int 55 ) 124 | ] 125 | |> Json.Encode.object 126 | |> Http.jsonBody 127 | , expect = Http.expectWhatever NewPersonAdded 128 | } 129 | ) 130 | 131 | 132 | view : Model -> Document Msg 133 | view model = 134 | { title = "Hello DB Client" 135 | , body = [ layout [ width fill, height fill ] (viewBody model) ] 136 | } 137 | 138 | 139 | viewBody : Model -> Element Msg 140 | viewBody { persons } = 141 | column [ centerX, spacing 16, padding 16 ] 142 | [ el [ Font.size 32, Font.underline ] <| 143 | text "PERSONS" 144 | , column [ spacing 16, centerX ] <| 145 | case persons of 146 | NotYetRequested -> 147 | [ text "You should load the persons" ] 148 | 149 | Loading -> 150 | [ text "Loading Persons..." ] 151 | 152 | Failure err -> 153 | [ text ("Failed to load the persons: " ++ Debug.toString err) ] 154 | 155 | Success people -> 156 | List.map viewPerson people 157 | , Input.button [] 158 | { label = text "Create" 159 | , onPress = Just CreatePerson 160 | } 161 | ] 162 | 163 | 164 | viewPerson : Person -> Element Msg 165 | viewPerson person = 166 | column [] 167 | [ text ("Name: " ++ Person.getName person) 168 | , person 169 | |> Person.getAge 170 | |> String.fromInt 171 | |> (++) "Age: " 172 | |> text 173 | , Input.button [] 174 | { label = text "Delete" 175 | , onPress = Just (DeletePerson person) 176 | } 177 | ] 178 | -------------------------------------------------------------------------------- /examples/HelloDBServer.elm: -------------------------------------------------------------------------------- 1 | module HelloDBServer exposing (main) 2 | 3 | import Database.Postgres exposing (WhereCondition(..)) 4 | import Error 5 | import File 6 | import Json.Decode 7 | import Person 8 | import Response 9 | import Result.Extra 10 | import Server exposing (Config, Flags, Method(..), Request, Response) 11 | import Status exposing (Status(..)) 12 | 13 | 14 | main : Server.Program 15 | main = 16 | Server.program 17 | { init = init 18 | , handler = handler 19 | } 20 | 21 | 22 | init : Flags -> Config 23 | init _ = 24 | Server.baseConfig 25 | |> Database.Postgres.connect 26 | { hostname = "localhost" 27 | , port_ = 5432 28 | , database = "postgres" 29 | , user = "postgres" 30 | , password = "postgres" 31 | } 32 | 33 | 34 | handler : Request -> Response 35 | handler request = 36 | case ( Server.getMethod request, Server.getPath request ) of 37 | ( Get, [] ) -> 38 | File.load "./examples/hello-db-client.html" 39 | |> Server.onSuccess 40 | (Json.Decode.decodeValue Json.Decode.string 41 | >> Result.map 42 | (\file -> 43 | Response.ok 44 | |> Response.setBody file 45 | |> Server.respond request 46 | ) 47 | >> Result.mapError 48 | (Json.Decode.errorToString >> Response.error >> Server.respond request) 49 | >> Result.Extra.merge 50 | ) 51 | |> Server.onError (Error.toString >> Response.error >> Server.respond request) 52 | 53 | ( _, "persons" :: restOfPath ) -> 54 | Person.handler request restOfPath 55 | 56 | _ -> 57 | Server.respond request Response.notFound 58 | -------------------------------------------------------------------------------- /examples/HelloFile.elm: -------------------------------------------------------------------------------- 1 | module HelloFile exposing (main) 2 | 3 | import Error 4 | import File 5 | import Json.Decode 6 | import Response 7 | import Result.Extra 8 | import Server exposing (Config, Flags, Request, Response) 9 | import Status exposing (Status(..)) 10 | 11 | 12 | main : Server.Program 13 | main = 14 | Server.program 15 | { init = init 16 | , handler = handler 17 | } 18 | 19 | 20 | init : Flags -> Config 21 | init _ = 22 | Server.baseConfig 23 | 24 | 25 | handler : Request -> Response 26 | handler request = 27 | case Server.getPath request of 28 | [] -> 29 | File.load "./examples/hello.html" 30 | |> Server.onSuccess 31 | (Json.Decode.decodeValue Json.Decode.string 32 | >> Result.map 33 | (\file -> 34 | Response.ok 35 | |> Response.setBody file 36 | |> Server.respond request 37 | ) 38 | >> Result.mapError 39 | (Json.Decode.errorToString >> Response.error >> Server.respond request) 40 | >> Result.Extra.merge 41 | ) 42 | |> Server.onError (Error.toString >> Response.error >> Server.respond request) 43 | 44 | _ -> 45 | Server.respond request Response.notFound 46 | -------------------------------------------------------------------------------- /examples/HelloWorld.elm: -------------------------------------------------------------------------------- 1 | module HelloWorld exposing (main) 2 | 3 | import Error 4 | import Html.String as Html 5 | import Html.String.Attributes as Attr 6 | import Logger as Log 7 | import Response 8 | import Server exposing (Config, Flags, Request, Response) 9 | 10 | 11 | main : Server.Program 12 | main = 13 | Server.program 14 | { init = init 15 | , handler = handler 16 | } 17 | 18 | 19 | init : Flags -> Config 20 | init _ = 21 | Server.baseConfig 22 | 23 | 24 | handler : Request -> Response 25 | handler request = 26 | case Server.getPath request of 27 | [] -> 28 | Response.ok 29 | |> Response.setBody indexPage 30 | |> Server.respond request 31 | |> Server.andThen (\_ -> Log.toConsole "index page requested") 32 | 33 | [ "hello" ] -> 34 | let 35 | maybeName = 36 | Server.getQueryParams request 37 | |> listFind (\( key, _ ) -> key == "name") 38 | in 39 | case maybeName of 40 | Just ( _, Just name ) -> 41 | Log.toConsole ("Saying hello to " ++ name) 42 | |> Server.andThen 43 | (\_ -> 44 | Response.ok 45 | |> Response.setBody ("Hello, " ++ name ++ "!") 46 | |> Server.respond request 47 | ) 48 | 49 | _ -> 50 | Response.ok 51 | |> Response.setBody "What is your name?" 52 | |> Server.respond request 53 | 54 | _ -> 55 | Response.notFound 56 | |> Server.respond request 57 | 58 | 59 | listFind : (a -> Bool) -> List a -> Maybe a 60 | listFind predicate list = 61 | case list of 62 | [] -> 63 | Nothing 64 | 65 | next :: rest -> 66 | if predicate next then 67 | Just next 68 | 69 | else 70 | listFind predicate rest 71 | 72 | 73 | indexPage : String 74 | indexPage = 75 | Html.div 76 | [] 77 | [ Html.h1 [] [ Html.text "Howdy, Partner" ] 78 | , Html.nav 79 | [] 80 | [ Html.a 81 | [ Attr.href "" ] 82 | [ Html.text "Home" ] 83 | , Html.a 84 | [ Attr.href "hello?name=carl" ] 85 | [ Html.text "Say Hello" ] 86 | ] 87 | ] 88 | |> Html.toString 2 89 | |> (++) "Fun With Elm" 90 | |> (\html -> 91 | html 92 | ++ "" 93 | ) 94 | -------------------------------------------------------------------------------- /examples/SecureWorld.elm: -------------------------------------------------------------------------------- 1 | module SecureWorld exposing (main) 2 | 3 | import Response 4 | import Server exposing (Config, Flags, Request, Response) 5 | import Status exposing (Status(..)) 6 | 7 | 8 | main : Server.Program 9 | main = 10 | Server.program 11 | { init = init 12 | , handler = handler 13 | } 14 | 15 | 16 | init : Flags -> Config 17 | init _ = 18 | Server.baseConfig 19 | |> Server.makeSecure 20 | { certificatePath = "./examples/cert.pem" 21 | , keyPath = "./examples/private.pem" 22 | } 23 | 24 | 25 | handler : Request -> Response 26 | handler request = 27 | case Server.getPath request of 28 | [] -> 29 | Server.respond request (Response.ok |> Response.setBody "Hello, HTTPS") 30 | 31 | _ -> 32 | Server.respond request Response.notFound 33 | -------------------------------------------------------------------------------- /src/ContentType.elm: -------------------------------------------------------------------------------- 1 | module ContentType exposing (ContentType(..), fromString, toString) 2 | 3 | 4 | type ContentType 5 | = Text_Html 6 | | Application_Json 7 | 8 | 9 | toString : ContentType -> String 10 | toString type_ = 11 | case type_ of 12 | Text_Html -> 13 | "text/html" 14 | 15 | Application_Json -> 16 | "application/json" 17 | 18 | 19 | fromString : String -> Maybe ContentType 20 | fromString maybeType = 21 | case maybeType of 22 | "text/html" -> 23 | Just Text_Html 24 | 25 | "application/json" -> 26 | Just Application_Json 27 | 28 | _ -> 29 | Nothing 30 | -------------------------------------------------------------------------------- /src/Database/Postgres.elm: -------------------------------------------------------------------------------- 1 | module Database.Postgres exposing 2 | ( WhereCondition(..) 3 | , connect 4 | , deleteQuery 5 | , insertQuery 6 | , selectQuery 7 | , wrapString 8 | ) 9 | 10 | import Internal.Server exposing (Config(..), Query(..)) 11 | 12 | 13 | connect : 14 | { hostname : String 15 | , port_ : Int 16 | , user : String 17 | , password : String 18 | , database : String 19 | } 20 | -> Config 21 | -> Config 22 | connect { hostname, port_, user, password, database } (Config config) = 23 | Config 24 | { config 25 | | databaseConnection = 26 | Just 27 | { hostname = hostname 28 | , port_ = port_ 29 | , user = user 30 | , password = password 31 | , database = database 32 | } 33 | } 34 | 35 | 36 | insertQuery : { tableName : String, columnValues : List String } -> Query 37 | insertQuery { tableName, columnValues } = 38 | "INSERT INTO " ++ tableName ++ " VALUES(DEFAULT, " ++ String.join ", " columnValues ++ ");" |> Query 39 | 40 | 41 | selectQuery : { tableName : String, where_ : WhereCondition } -> Query 42 | selectQuery { tableName, where_ } = 43 | "SELECT * FROM " ++ tableName ++ addWhereClause where_ ++ ";" |> Query 44 | 45 | 46 | deleteQuery : { tableName : String, where_ : WhereCondition } -> Query 47 | deleteQuery { tableName, where_ } = 48 | "DELETE FROM " ++ tableName ++ addWhereClause where_ ++ ";" |> Query 49 | 50 | 51 | addWhereClause : WhereCondition -> String 52 | addWhereClause condition = 53 | let 54 | result = 55 | addWhereClauseHelper condition 56 | in 57 | if String.isEmpty result then 58 | result 59 | 60 | else 61 | " WHERE " ++ result 62 | 63 | 64 | addWhereClauseHelper : WhereCondition -> String 65 | addWhereClauseHelper condition = 66 | case condition of 67 | NoCondition -> 68 | "" 69 | 70 | And a b -> 71 | addWhereClause a ++ " AND " ++ addWhereClause b 72 | 73 | Or a b -> 74 | addWhereClause a ++ " OR " ++ addWhereClause b 75 | 76 | Equal name val -> 77 | name ++ " = " ++ val 78 | 79 | GreaterThan name val -> 80 | name ++ " > " ++ val 81 | 82 | LessThan name val -> 83 | name ++ " < " ++ val 84 | 85 | GreaterThanOrEqual name val -> 86 | name ++ " >= " ++ val 87 | 88 | LessThanOrEqual name val -> 89 | name ++ " <= " ++ val 90 | 91 | NotEqual name val -> 92 | name ++ " != " ++ val 93 | 94 | InList name items -> 95 | name ++ " IN (" ++ String.join "," items ++ ")" 96 | 97 | InQuery name (Query qry) -> 98 | name ++ " IN (" ++ String.dropRight 1 qry ++ ")" 99 | 100 | Like name pattern -> 101 | name ++ " LIKE " ++ pattern 102 | 103 | IsNull name -> 104 | name ++ " = NULL" 105 | 106 | NotCondition cond -> 107 | "NOT " ++ addWhereClauseHelper cond 108 | 109 | 110 | type WhereCondition 111 | = NoCondition 112 | | Equal String String 113 | | GreaterThan String String 114 | | LessThan String String 115 | | GreaterThanOrEqual String String 116 | | LessThanOrEqual String String 117 | | NotEqual String String 118 | | And WhereCondition WhereCondition 119 | | Or WhereCondition WhereCondition 120 | | InList String (List String) 121 | | InQuery String Query 122 | | Like String String 123 | | IsNull String 124 | | NotCondition WhereCondition 125 | 126 | 127 | wrapString : String -> String 128 | wrapString str = 129 | "'" ++ str ++ "'" 130 | -------------------------------------------------------------------------------- /src/Database/Sqlite.elm: -------------------------------------------------------------------------------- 1 | module Database.Sqlite exposing (Database, DefaultType(..), Path(..), Table) 2 | 3 | import Dict exposing (Dict) 4 | import Html.Attributes exposing (name) 5 | import Json.Encode exposing (Value) 6 | import String.Extra 7 | 8 | 9 | type Path 10 | = InMemory 11 | | Exact String 12 | 13 | 14 | type alias Database = 15 | { tables : Dict Name Table 16 | , path : Path 17 | } 18 | 19 | 20 | type alias Name = 21 | String 22 | 23 | 24 | type alias Table = 25 | { columns : Dict Name Column 26 | , primaryKey : List Name 27 | } 28 | 29 | 30 | type alias Column = 31 | { type_ : DefaultType 32 | , isUnique : Bool 33 | } 34 | 35 | 36 | type DefaultType 37 | = Integer (Maybe Int) 38 | | Text (Maybe String) 39 | | Real (Maybe Float) 40 | | Blob (Maybe String) 41 | 42 | 43 | query : String -> List Value -> Value 44 | query qry values = 45 | Json.Encode.object 46 | [ ( "query", Json.Encode.string qry ) 47 | , ( "values", Json.Encode.list identity values ) 48 | ] 49 | 50 | 51 | type alias File = 52 | String 53 | 54 | 55 | type Error 56 | = MissingPath 57 | | NoTables 58 | 59 | 60 | generateSqlite : Database -> Result Error (Dict String File) 61 | generateSqlite database = 62 | -- validatePath database.path 63 | -- |> Result.map (\() -> generateTables database.tables) 64 | Err MissingPath 65 | 66 | 67 | validatePath : Path -> Result Error () 68 | validatePath path = 69 | case path of 70 | Exact "" -> 71 | Err MissingPath 72 | 73 | _ -> 74 | Ok () 75 | 76 | 77 | 78 | -- generateTables : Dict Name Table -> Result Error (Dict String File) 79 | -- generateTables tables = 80 | -- if Dict.isEmpty tables then 81 | -- Err NoTables 82 | -- else 83 | -- tables 84 | -- |> Dict.toList 85 | -- |> List.map generateTable 86 | -- |> Dict.fromList 87 | 88 | 89 | generateTable : ( Name, Table ) -> Result Error ( String, File ) 90 | generateTable ( name, table ) = 91 | "module Database.Table." 92 | ++ String.Extra.toTitleCase name 93 | ++ """ exposing (select, Column) 94 | 95 | import Database.Sqlite exposing (Query) 96 | 97 | type Column 98 | = """ 99 | ++ (table.columns 100 | |> Dict.keys 101 | |> List.map String.Extra.toTitleCase 102 | |> String.join " | " 103 | ) 104 | ++ """ 105 | 106 | 107 | columnToString : Column -> String 108 | columnToString column = 109 | case column of 110 | """ 111 | ++ (table.columns 112 | |> Dict.keys 113 | |> List.map (\col -> String.Extra.toTitleCase col ++ " -> " ++ col) 114 | |> String.join "\n " 115 | ) 116 | ++ """ 117 | 118 | 119 | type ColumnSelection 120 | = All 121 | | Distinct (List Column) 122 | 123 | select : ColumnSelection -> Query 124 | select columns = 125 | "SELECT " 126 | ++ (case columns of 127 | All -> "*" 128 | Distinct cols -> 129 | cols 130 | |> List.map columnToString 131 | |> String.join ", " 132 | |> (\\c -> "(" ++ c ++ ")") 133 | ) 134 | ++ " FROM """ 135 | ++ name 136 | ++ """ 137 | """ 138 | |> Tuple.pair ("Database/Table/" ++ String.Extra.toTitleCase name ++ ".elm") 139 | |> Ok 140 | 141 | 142 | 143 | -- module Database.Sqlite exposing (Column(..), create, fromTable, query, select, withRestrictions) 144 | -- import Json.Encode exposing (Value) 145 | -- import Server.Internal exposing (Command, CommandCmd, Request(..), Server(..)) 146 | -- create : { name : String, columns : List ColumnDefinition } -> CommandCmd 147 | -- create { name, columns } = 148 | -- { msg = "DATABASE_CREATE" 149 | -- , args = 150 | -- Json.Encode.string <| 151 | -- "CREAT TABLE " 152 | -- ++ name 153 | -- ++ " (" 154 | -- ++ (List.map createColumn columns |> String.join ", ") 155 | -- ++ ");" 156 | -- } 157 | -- createColumn : ColumnDefinition -> String 158 | -- createColumn { name, type_, constraints } = 159 | -- name ++ " " ++ typeToString type_ ++ constraintsToString constraints 160 | -- type alias ColumnDefinition = 161 | -- { name : String 162 | -- , type_ : ColumnType 163 | -- , constraints : List Constraint 164 | -- } 165 | -- type ColumnType 166 | -- = Text 167 | -- | Integer 168 | -- typeToString : ColumnType -> String 169 | -- typeToString colType = 170 | -- case colType of 171 | -- Text -> 172 | -- "TEXT" 173 | -- Integer -> 174 | -- "INTEGER" 175 | -- type Constraint 176 | -- = PrimaryKey 177 | -- | NotNull 178 | -- | Unique 179 | -- | ForeignKey 180 | -- | Check 181 | -- | None 182 | -- constraintsToString : List Constraint -> String 183 | -- constraintsToString constraints = 184 | -- if List.member None constraints then 185 | -- "" 186 | -- else 187 | -- List.map constraintToString constraints 188 | -- |> String.join " " 189 | -- |> (++) " " 190 | -- constraintToString : Constraint -> String 191 | -- constraintToString constraint = 192 | -- case constraint of 193 | -- PrimaryKey -> 194 | -- "PRIMARY KEY" 195 | -- NotNull -> 196 | -- "NOT NULL" 197 | -- Unique -> 198 | -- "UNIQUE" 199 | -- ForeignKey -> 200 | -- "FOREIGN KEY" 201 | -- Check -> 202 | -- "CHECK" 203 | -- None -> 204 | -- "" 205 | -- query : (Result String Value -> Command) -> Query -> Server -> ( Server, CommandCmd ) 206 | -- query continuation qry server = 207 | -- let 208 | -- ( nextServer, continuationKey ) = 209 | -- Server.Internal.insertContinuation continuation server 210 | -- in 211 | -- ( nextServer 212 | -- , { msg = "DATABASE" 213 | -- , args = 214 | -- Json.Encode.object 215 | -- [ ( "query", encodeQuery qry ) 216 | -- , ( "continuationKey", Json.Encode.int continuationKey ) 217 | -- ] 218 | -- } 219 | -- ) 220 | -- encodeQuery : Query -> Value 221 | -- encodeQuery (Query qry) = 222 | -- Json.Encode.string qry 223 | -- select : Column -> Query 224 | -- select column = 225 | -- let 226 | -- colName = 227 | -- case column of 228 | -- AllColumns -> 229 | -- "*" 230 | -- Column name -> 231 | -- name 232 | -- in 233 | -- Query ("SELECT " ++ colName) 234 | -- fromTable : String -> Query -> Query 235 | -- fromTable name (Query qry) = 236 | -- Query (qry ++ " FROM " ++ name) 237 | -- withRestrictions : List Restriction -> Query -> Query 238 | -- withRestrictions restrictions (Query qry) = 239 | -- restrictions 240 | -- |> List.map identity 241 | -- |> String.join " " 242 | -- |> (++) qry 243 | -- |> Query 244 | -- type alias Restriction = 245 | -- String 246 | -- type Query 247 | -- = Query String 248 | -- type Column 249 | -- = AllColumns 250 | -- | Column String 251 | -- type alias Table = 252 | -- String 253 | -------------------------------------------------------------------------------- /src/Error.elm: -------------------------------------------------------------------------------- 1 | module Error exposing (Error(..), toString, fromString) 2 | 3 | import Json.Decode 4 | 5 | 6 | type Error 7 | = TypeError Json.Decode.Error 8 | | RuntimeError String 9 | 10 | 11 | toString : Error -> String 12 | toString error = 13 | case error of 14 | TypeError err -> 15 | "Type Error: " ++ Json.Decode.errorToString err 16 | 17 | RuntimeError err -> 18 | "Runtime Error: " ++ err 19 | 20 | 21 | fromString : String -> Error 22 | fromString = 23 | RuntimeError 24 | -------------------------------------------------------------------------------- /src/File.elm: -------------------------------------------------------------------------------- 1 | module File exposing (load) 2 | 3 | import Internal.Server exposing (runTask) 4 | import Json.Encode 5 | import Server exposing (Response) 6 | 7 | 8 | load : String -> Response 9 | load path = 10 | runTask "FILE_SYSTEM_READ" (Json.Encode.string path) 11 | -------------------------------------------------------------------------------- /src/Internal/Response.elm: -------------------------------------------------------------------------------- 1 | module Internal.Response exposing (Header(..), InternalResponse(..), ResponseData, base, map) 2 | 3 | import ContentType exposing (ContentType(..)) 4 | import Status exposing (Status(..)) 5 | 6 | 7 | type InternalResponse 8 | = InternalResponse ResponseData 9 | 10 | 11 | type alias ResponseData = 12 | { status : Status 13 | , body : String 14 | , contentType : ContentType 15 | , headers : List Header 16 | } 17 | 18 | 19 | type Header = Header 20 | { key : String 21 | , value : String 22 | } 23 | 24 | 25 | base : InternalResponse 26 | base = 27 | InternalResponse 28 | { status = StatusOk 29 | , body = "OK" 30 | , contentType = Text_Html 31 | , headers = [] 32 | } 33 | 34 | 35 | map : (ResponseData -> ResponseData) -> InternalResponse -> InternalResponse 36 | map fn (InternalResponse response) = 37 | InternalResponse (fn response) 38 | -------------------------------------------------------------------------------- /src/Internal/Server.elm: -------------------------------------------------------------------------------- 1 | module Internal.Server exposing 2 | ( Certs 3 | , Config(..) 4 | , ConfigData 5 | , Query(..) 6 | , Type(..) 7 | , query 8 | , runTask 9 | ) 10 | 11 | import Error exposing (Error(..)) 12 | import Json.Decode exposing (Decoder) 13 | import Json.Encode exposing (Value) 14 | import Process 15 | import Task exposing (Task) 16 | 17 | 18 | type Config 19 | = Config ConfigData 20 | 21 | 22 | type alias ConfigData = 23 | { port_ : Int 24 | , type_ : Type 25 | , databaseConnection : Maybe DatabaseConnection 26 | , envPath : List String 27 | } 28 | 29 | 30 | type alias DatabaseConnection = 31 | { hostname : String 32 | , port_ : Int 33 | , user : String 34 | , password : String 35 | , database : String 36 | } 37 | 38 | 39 | type Type 40 | = Basic 41 | | Secure Certs 42 | 43 | 44 | type alias Certs = 45 | { certificatePath : String 46 | , keyPath : String 47 | } 48 | 49 | 50 | runTask : String -> Value -> Task Error Value 51 | runTask message args = 52 | evalAsync message args Json.Decode.value 53 | 54 | 55 | type Query 56 | = Query String 57 | 58 | 59 | query : Query -> Task Error Value 60 | query (Query qry) = 61 | qry 62 | |> Json.Encode.string 63 | |> runTask "DATABASE_QUERY" 64 | 65 | 66 | 67 | -- eval : List Value -> Code -> Decoder a -> Result Error a 68 | -- eval params code decoder = 69 | -- Json.Encode.object [ ( "__elm_interop", Json.Encode.list identity (Json.Encode.string code :: params) ) ] 70 | -- |> Json.Decode.decodeValue (Json.Decode.field "__elm_interop" (decodeEvalResult decoder)) 71 | -- |> Result.mapError TypeError 72 | -- |> Result.andThen identity 73 | 74 | 75 | evalAsync : String -> Value -> Decoder a -> Task Error a 76 | evalAsync message args decoder = 77 | let 78 | token = 79 | Json.Encode.object [] 80 | in 81 | Task.succeed () 82 | |> Task.andThen 83 | (\_ -> 84 | let 85 | _ = 86 | Json.Encode.object [ ( "__elm_interop_async", Json.Encode.list identity [ token, Json.Encode.string message, args ] ) ] 87 | in 88 | -- 69 108 109 == Elm 89 | Process.sleep -69108109 90 | ) 91 | |> Task.andThen 92 | (\_ -> 93 | case 94 | Json.Encode.object [ ( "token", token ) ] 95 | |> Json.Decode.decodeValue (Json.Decode.field "__elm_interop_async" (decodeEvalResult decoder)) 96 | |> Result.mapError TypeError 97 | |> Result.andThen identity 98 | of 99 | Ok result -> 100 | Task.succeed result 101 | 102 | Err error -> 103 | Task.fail error 104 | ) 105 | 106 | 107 | decodeEvalResult : Decoder a -> Decoder (Result Error a) 108 | decodeEvalResult decodeResult = 109 | Json.Decode.field "tag" Json.Decode.string 110 | |> Json.Decode.andThen 111 | (\tag -> 112 | case tag of 113 | "Ok" -> 114 | Json.Decode.value 115 | |> Json.Decode.andThen 116 | (\value -> 117 | Json.Decode.decodeValue (Json.Decode.field "result" decodeResult) value 118 | |> Result.mapError TypeError 119 | |> Json.Decode.succeed 120 | ) 121 | 122 | "Error" -> 123 | Json.Decode.field "error" decodeRuntimeError 124 | |> Json.Decode.map Err 125 | 126 | _ -> 127 | Json.Decode.value 128 | |> Json.Decode.andThen 129 | (\value -> 130 | Json.Decode.succeed 131 | (Json.Decode.Failure ("`tag` field must be one of Ok/Error, instead found `" ++ tag ++ "`") value 132 | |> TypeError 133 | |> Err 134 | ) 135 | ) 136 | ) 137 | 138 | 139 | decodeRuntimeError : Decoder Error 140 | decodeRuntimeError = 141 | Json.Decode.field "message" Json.Decode.string |> Json.Decode.map RuntimeError 142 | -------------------------------------------------------------------------------- /src/Jwt.elm: -------------------------------------------------------------------------------- 1 | module Jwt exposing (Header, Key, Payload, Token, make, validate) 2 | 3 | import Internal.Server exposing (runTask) 4 | import Json.Encode 5 | import Server exposing (Response) 6 | 7 | 8 | type alias Header = 9 | { algorithm : String 10 | , typ : String 11 | } 12 | 13 | 14 | type alias Token = 15 | String 16 | 17 | 18 | type alias Payload = 19 | { iss : String 20 | , expiration : Int 21 | } 22 | 23 | 24 | type alias Key = 25 | String 26 | 27 | 28 | make : { header : Header, payload : Payload, key : Key } -> Response 29 | make args = 30 | [ ( "header" 31 | , Json.Encode.object 32 | [ ( "alg", Json.Encode.string args.header.algorithm ) 33 | , ( "typ", Json.Encode.string args.header.typ ) 34 | ] 35 | ) 36 | , ( "payload" 37 | , Json.Encode.object 38 | [ ( "iss", Json.Encode.string args.payload.iss ) 39 | , ( "exp", Json.Encode.int args.payload.expiration ) 40 | ] 41 | ) 42 | , ( "key", Json.Encode.string args.key ) 43 | ] 44 | |> Json.Encode.object 45 | |> runTask "JWT_GENERATE" 46 | 47 | 48 | validate : { token : Token, key : Key, algorithm : String } -> Response 49 | validate args = 50 | [ ( "jwt", Json.Encode.string args.token ) 51 | , ( "key", Json.Encode.string args.key ) 52 | , ( "algorithm", Json.Encode.string args.algorithm ) 53 | ] 54 | |> Json.Encode.object 55 | |> runTask "JWT_VALIDATE" 56 | -------------------------------------------------------------------------------- /src/Logger.elm: -------------------------------------------------------------------------------- 1 | module Logger exposing (toConsole) 2 | 3 | import Internal.Server exposing (runTask) 4 | import Json.Encode 5 | import Server exposing (Response) 6 | 7 | 8 | toConsole : String -> Response 9 | toConsole message = 10 | runTask "PRINT" (Json.Encode.string message) 11 | -------------------------------------------------------------------------------- /src/Response.elm: -------------------------------------------------------------------------------- 1 | module Response exposing 2 | ( Header 3 | , Response 4 | , error 5 | , json 6 | , methodNotAllowed 7 | , notFound 8 | , ok 9 | , setBody 10 | , setContentType 11 | , setStatus 12 | , addHeader 13 | ) 14 | 15 | import ContentType exposing (ContentType(..)) 16 | import Internal.Response exposing (Header, InternalResponse(..)) 17 | import Json.Encode exposing (Value) 18 | import Status exposing (Status(..)) 19 | 20 | 21 | setStatus : Status -> Response -> Response 22 | setStatus status = 23 | Internal.Response.map (\r -> { r | status = status }) 24 | 25 | 26 | setBody : String -> Response -> Response 27 | setBody body = 28 | Internal.Response.map (\r -> { r | body = body }) 29 | 30 | 31 | setContentType : ContentType -> Response -> Response 32 | setContentType contentType = 33 | Internal.Response.map (\r -> { r | contentType = contentType }) 34 | 35 | 36 | addHeader : String -> String -> Response -> Response 37 | addHeader key value = 38 | Internal.Response.map 39 | (\r -> 40 | { r 41 | | headers = 42 | Internal.Response.Header 43 | { key = key 44 | , value = value 45 | } 46 | :: r.headers 47 | } 48 | ) 49 | 50 | 51 | type alias Response = 52 | InternalResponse 53 | 54 | 55 | type alias Header 56 | = Internal.Response.Header 57 | 58 | 59 | ok : Response 60 | ok = 61 | Internal.Response.base 62 | 63 | 64 | header : String -> String -> Header 65 | header key value = 66 | Internal.Response.Header { key = key, value = value } 67 | 68 | 69 | json : Value -> Response 70 | json body = 71 | Internal.Response.base 72 | |> Internal.Response.map 73 | (\r -> 74 | { r 75 | | body = Json.Encode.encode 0 body 76 | , contentType = Application_Json 77 | } 78 | ) 79 | 80 | 81 | notFound : Response 82 | notFound = 83 | Internal.Response.base 84 | |> Internal.Response.map (\r -> { r | status = NotFound, body = "Not Found" }) 85 | 86 | 87 | error : String -> Response 88 | error body = 89 | Internal.Response.base 90 | |> Internal.Response.map (\r -> { r | status = InternalServerError, body = body }) 91 | 92 | 93 | methodNotAllowed : Response 94 | methodNotAllowed = 95 | Internal.Response.base 96 | |> Internal.Response.map (\r -> { r | status = MethodNotAllowed, body = "Method Not Allowed" }) 97 | -------------------------------------------------------------------------------- /src/Server.elm: -------------------------------------------------------------------------------- 1 | port module Server exposing 2 | ( Config 3 | , Flags 4 | , Method(..) 5 | , Path 6 | , Program 7 | , Request 8 | , Response 9 | , andThen 10 | , baseConfig 11 | , decodeBody 12 | , envAtPath 13 | , getBody 14 | , getMethod 15 | , getPath 16 | , getQueryParams 17 | , makeSecure 18 | , map 19 | , mapError 20 | , methodToString 21 | , onError 22 | , onSuccess 23 | , program 24 | , query 25 | , respond 26 | , resultToResponse 27 | , withPort 28 | ) 29 | 30 | import ContentType 31 | import Error exposing (Error(..)) 32 | import Html.Attributes exposing (value) 33 | import Internal.Response exposing (InternalResponse(..)) 34 | import Internal.Server exposing (Certs, Config(..), Query, Type(..), runTask) 35 | import Json.Decode exposing (Decoder) 36 | import Json.Decode.Extra 37 | import Json.Encode exposing (Value) 38 | import Platform 39 | import Response 40 | import Result.Extra 41 | import Status 42 | import Task exposing (Task, onError) 43 | 44 | 45 | type alias Program = 46 | Platform.Program Flags () Msg 47 | 48 | 49 | type alias Flags = 50 | { environment : Value 51 | , arguments : Value 52 | } 53 | 54 | 55 | type Request 56 | = Request InternalRequest 57 | 58 | 59 | type alias InternalRequest = 60 | { body : Value 61 | , path : Path 62 | , method : Method 63 | , queryParams : List QueryParam 64 | , actualRequest : Value 65 | } 66 | 67 | 68 | type alias QueryParam = 69 | ( String, Maybe String ) 70 | 71 | 72 | getBody : Request -> Value 73 | getBody (Request { body }) = 74 | body 75 | 76 | 77 | decodeBody : Decoder a -> Request -> Result Json.Decode.Error a 78 | decodeBody decoder (Request { body }) = 79 | Json.Decode.decodeValue (Json.Decode.Extra.doubleEncoded decoder) body 80 | 81 | 82 | getPath : Request -> Path 83 | getPath (Request { path }) = 84 | path 85 | 86 | 87 | getMethod : Request -> Method 88 | getMethod (Request { method }) = 89 | method 90 | 91 | 92 | getQueryParams : Request -> List QueryParam 93 | getQueryParams (Request { queryParams }) = 94 | queryParams 95 | 96 | 97 | type alias IncomingRequest = 98 | Value 99 | 100 | 101 | type alias Response = 102 | Task Error Value 103 | 104 | 105 | type alias Config = 106 | Internal.Server.Config 107 | 108 | 109 | type alias Path = 110 | List String 111 | 112 | 113 | baseConfig : Config 114 | baseConfig = 115 | Config 116 | { port_ = 1234 117 | , type_ = Internal.Server.Basic 118 | , databaseConnection = Nothing 119 | , envPath = [] 120 | } 121 | 122 | 123 | makeSecure : Certs -> Config -> Config 124 | makeSecure certs (Config config) = 125 | Config { config | type_ = Secure certs } 126 | 127 | 128 | withPort : Int -> Config -> Config 129 | withPort port_ (Config config) = 130 | Config { config | port_ = port_ } 131 | 132 | 133 | envAtPath : Path -> Config -> Config 134 | envAtPath envPath (Config config) = 135 | Config { config | envPath = envPath } 136 | 137 | 138 | type Msg 139 | = IncomingRequest Value 140 | | Continuation (Result Error Value) 141 | 142 | 143 | port requestPort : (Value -> msg) -> Sub msg 144 | 145 | 146 | program : { init : Flags -> Config, handler : Request -> Response } -> Program 147 | program { init, handler } = 148 | Platform.worker 149 | { init = 150 | \flags -> 151 | let 152 | (Config { port_, type_, databaseConnection }) = 153 | init flags 154 | 155 | initialTasks = 156 | if port_ < 1 || port_ > 65535 then 157 | "Error: Invalid port: " 158 | ++ String.fromInt port_ 159 | ++ ", must be between 1 and 65,535." 160 | |> Json.Encode.string 161 | |> runTask "PRINT" 162 | 163 | else 164 | let 165 | startupConfig = 166 | Json.Encode.object 167 | [ ( "port", Json.Encode.int port_ ) 168 | , ( "databaseConnection" 169 | , case databaseConnection of 170 | Nothing -> 171 | Json.Encode.null 172 | 173 | Just connectionData -> 174 | Json.Encode.object 175 | [ ( "hostname", Json.Encode.string connectionData.hostname ) 176 | , ( "port", Json.Encode.int connectionData.port_ ) 177 | , ( "user", Json.Encode.string connectionData.user ) 178 | , ( "password", Json.Encode.string connectionData.password ) 179 | , ( "database", Json.Encode.string connectionData.database ) 180 | ] 181 | ) 182 | , ( "certs" 183 | , case type_ of 184 | Basic -> 185 | Json.Encode.null 186 | 187 | Secure { certificatePath, keyPath } -> 188 | Json.Encode.object 189 | [ ( "certificatePath", Json.Encode.string certificatePath ) 190 | , ( "keyPath", Json.Encode.string keyPath ) 191 | ] 192 | ) 193 | ] 194 | in 195 | runTask "SERVE" startupConfig 196 | in 197 | ( (), executeTasks initialTasks ) 198 | , subscriptions = subscriptions 199 | , update = update handler 200 | } 201 | 202 | 203 | subscriptions : () -> Sub Msg 204 | subscriptions () = 205 | requestPort IncomingRequest 206 | 207 | 208 | executeTasks : Task Error Value -> Cmd Msg 209 | executeTasks = 210 | Task.attempt Continuation 211 | 212 | 213 | update : (Request -> Response) -> Msg -> () -> ( (), Cmd Msg ) 214 | update handler msg () = 215 | ( () 216 | , case msg of 217 | IncomingRequest request -> 218 | request 219 | |> parseRequest 220 | |> Result.mapError 221 | (Error.toString 222 | >> Response.error 223 | >> respond 224 | (Request 225 | { body = Json.Encode.null 226 | , path = [] 227 | , method = Get 228 | , queryParams = [] 229 | , actualRequest = request 230 | } 231 | ) 232 | ) 233 | |> Result.map handler 234 | |> Result.Extra.merge 235 | |> executeTasks 236 | 237 | Continuation result -> 238 | case result of 239 | Err err -> 240 | -- This happens when the user doesn't handle `Server.onError` 241 | -- respond (Response.error err) context 242 | err 243 | |> Error.toString 244 | |> Json.Encode.string 245 | |> runTask "PRINT" 246 | |> executeTasks 247 | 248 | Ok _ -> 249 | -- Should something happen here? 250 | Cmd.none 251 | ) 252 | 253 | 254 | parseRequest : IncomingRequest -> Result Error Request 255 | parseRequest request = 256 | parsePath request 257 | |> Result.andThen 258 | (\( path, queryParams ) -> 259 | parseMethod request 260 | |> Result.andThen 261 | (\method -> 262 | parseBody request 263 | |> Result.map 264 | (\body -> 265 | Request 266 | { body = body 267 | , path = path 268 | , method = method 269 | , queryParams = queryParams 270 | , actualRequest = request 271 | } 272 | ) 273 | ) 274 | ) 275 | 276 | 277 | parsePath : IncomingRequest -> Result Error ( Path, List QueryParam ) 278 | parsePath request = 279 | Json.Decode.decodeValue (Json.Decode.field "url" Json.Decode.string) request 280 | |> Result.mapError TypeError 281 | |> Result.andThen 282 | (\pathStr -> 283 | case String.split "?" pathStr of 284 | [ pathOnly ] -> 285 | Ok 286 | ( buildPath pathOnly 287 | , [] 288 | ) 289 | 290 | [ path, paramsStr ] -> 291 | Ok 292 | ( buildPath path 293 | , paramsStr 294 | |> String.split "&" 295 | |> List.map buildQueryParam 296 | ) 297 | 298 | _ -> 299 | Err (RuntimeError "Malformed request url") 300 | ) 301 | 302 | 303 | buildPath : String -> Path 304 | buildPath = 305 | String.split "/" >> List.filter (not << String.isEmpty) 306 | 307 | 308 | buildQueryParam : String -> QueryParam 309 | buildQueryParam str = 310 | case String.split "=" str of 311 | [ key, value ] -> 312 | ( key, Just value ) 313 | 314 | [ key ] -> 315 | ( key, Nothing ) 316 | 317 | _ -> 318 | ( str, Nothing ) 319 | 320 | 321 | parseMethod : IncomingRequest -> Result Error Method 322 | parseMethod request = 323 | Json.Decode.decodeValue (Json.Decode.field "method" Json.Decode.string) request 324 | |> Result.mapError TypeError 325 | |> Result.map methodFromString 326 | 327 | 328 | parseBody : IncomingRequest -> Result Error Value 329 | parseBody request = 330 | Json.Decode.decodeValue (Json.Decode.field "elmBody" Json.Decode.value) request 331 | |> Result.mapError TypeError 332 | 333 | 334 | methodFromString : String -> Method 335 | methodFromString method = 336 | case method of 337 | "GET" -> 338 | Get 339 | 340 | "POST" -> 341 | Post 342 | 343 | "PUT" -> 344 | Put 345 | 346 | "DELETE" -> 347 | Delete 348 | 349 | "OPTION" -> 350 | Option 351 | 352 | "HEAD" -> 353 | Head 354 | 355 | "CONNECT" -> 356 | Connect 357 | 358 | "OPTIONS" -> 359 | Options 360 | 361 | "TRACE" -> 362 | Trace 363 | 364 | "PATCH" -> 365 | Patch 366 | 367 | _ -> 368 | Unofficial method 369 | 370 | 371 | type Method 372 | = Get 373 | | Post 374 | | Put 375 | | Delete 376 | | Option 377 | | Head 378 | | Connect 379 | | Options 380 | | Trace 381 | | Patch 382 | | Unofficial String 383 | 384 | 385 | methodToString : Method -> String 386 | methodToString method = 387 | case method of 388 | Get -> 389 | "Get" 390 | 391 | Post -> 392 | "Post" 393 | 394 | Put -> 395 | "Put" 396 | 397 | Delete -> 398 | "Delete" 399 | 400 | Option -> 401 | "Option" 402 | 403 | Head -> 404 | "Head" 405 | 406 | Connect -> 407 | "Connect" 408 | 409 | Options -> 410 | "Options" 411 | 412 | Trace -> 413 | "Trace" 414 | 415 | Patch -> 416 | "Patch" 417 | 418 | Unofficial m -> 419 | m 420 | 421 | 422 | respond : Request -> InternalResponse -> Response 423 | respond (Request request) (InternalResponse { status, body, contentType }) = 424 | [ ( "options" 425 | , Json.Encode.object 426 | [ ( "status" 427 | , status 428 | |> Status.toCode 429 | |> Json.Encode.int 430 | ) 431 | , ( "body" 432 | , Json.Encode.string body 433 | ) 434 | , ( "headers" 435 | , [ [ Json.Encode.string "Content-Type" 436 | , contentType 437 | |> ContentType.toString 438 | |> Json.Encode.string 439 | ] 440 | ] 441 | |> List.map (Json.Encode.list identity) 442 | |> Json.Encode.list identity 443 | ) 444 | ] 445 | ) 446 | , ( "request", request.actualRequest ) 447 | ] 448 | |> Json.Encode.object 449 | |> runTask "RESPOND" 450 | 451 | 452 | andThen : (Value -> Response) -> Response -> Response 453 | andThen = 454 | Task.andThen 455 | 456 | 457 | map : (Value -> Value) -> Response -> Response 458 | map = 459 | Task.map 460 | 461 | 462 | mapError : (Error -> Error) -> Response -> Response 463 | mapError = 464 | Task.mapError 465 | 466 | 467 | onError : (Error -> Response) -> Response -> Response 468 | onError = 469 | Task.onError 470 | 471 | 472 | onSuccess : (Value -> Response) -> Response -> Response 473 | onSuccess = 474 | Task.andThen 475 | 476 | 477 | resultToResponse : Result String Value -> Response 478 | resultToResponse result = 479 | case result of 480 | Ok val -> 481 | Task.succeed val 482 | 483 | Err err -> 484 | Task.fail (RuntimeError err) 485 | 486 | 487 | query : Query -> Task Error Value 488 | query = 489 | Internal.Server.query 490 | -------------------------------------------------------------------------------- /src/Status.elm: -------------------------------------------------------------------------------- 1 | module Status exposing (Status(..), fromCode, toCode) 2 | 3 | 4 | type Status 5 | = Continue 6 | | SwitchingProtocols 7 | | Processing 8 | | EarlyHints 9 | | StatusOk 10 | | Created 11 | | Accepted 12 | | NonAuthoritativeInformation 13 | | NoContent 14 | | ResetContent 15 | | PartialContent 16 | | MultiStatus 17 | | AlreadyReported 18 | | IMUsed 19 | | MultipleChoices 20 | | MovedPermanently 21 | | Found 22 | | SeeOther 23 | | NotModified 24 | | UseProxy 25 | | SwitchProxy 26 | | TemporaryRedirect 27 | | PermanentRedirect 28 | | BadRequest 29 | | Unauthorized 30 | | PaymentRequired 31 | | Forbidden 32 | | NotFound 33 | | MethodNotAllowed 34 | | NotAcceptable 35 | | ProxyAuthenticationRequired 36 | | RequestTimeout 37 | | Conflict 38 | | Gone 39 | | LengthRequired 40 | | PreconditionFailed 41 | | PayloadTooLarge 42 | | URITooLong 43 | | UnsupportedMediaType 44 | | RangeNotSatisfiable 45 | | ExpectationFailed 46 | | ImATeapot 47 | | MisdirectedRequest 48 | | UnprocessableEntity 49 | | Locked 50 | | FailedDependency 51 | | TooEarly 52 | | UpgradeRequired 53 | | PreconditionRequired 54 | | TooManyRequests 55 | | RequestHeaderFieldsTooLarge 56 | | UnavailableForLegalReasons 57 | | InternalServerError 58 | | NotImplemented 59 | | BadGateway 60 | | ServiceUnavailable 61 | | GatewayTimeout 62 | | HTTPVersionNotSupported 63 | | VariantAlsoNegotiates 64 | | InsufficientStorage 65 | | LoopDetected 66 | | NotExtended 67 | | NetworkAuthenticationRequired 68 | | Unofficial Int 69 | 70 | 71 | toCode : Status -> Int 72 | toCode status = 73 | case status of 74 | Continue -> 75 | 100 76 | 77 | SwitchingProtocols -> 78 | 101 79 | 80 | Processing -> 81 | 102 82 | 83 | EarlyHints -> 84 | 103 85 | 86 | StatusOk -> 87 | 200 88 | 89 | Created -> 90 | 201 91 | 92 | Accepted -> 93 | 202 94 | 95 | NonAuthoritativeInformation -> 96 | 203 97 | 98 | NoContent -> 99 | 204 100 | 101 | ResetContent -> 102 | 205 103 | 104 | PartialContent -> 105 | 206 106 | 107 | MultiStatus -> 108 | 207 109 | 110 | AlreadyReported -> 111 | 208 112 | 113 | IMUsed -> 114 | 226 115 | 116 | MultipleChoices -> 117 | 300 118 | 119 | MovedPermanently -> 120 | 301 121 | 122 | Found -> 123 | 302 124 | 125 | SeeOther -> 126 | 303 127 | 128 | NotModified -> 129 | 304 130 | 131 | UseProxy -> 132 | 305 133 | 134 | SwitchProxy -> 135 | 306 136 | 137 | TemporaryRedirect -> 138 | 307 139 | 140 | PermanentRedirect -> 141 | 308 142 | 143 | BadRequest -> 144 | 400 145 | 146 | Unauthorized -> 147 | 401 148 | 149 | PaymentRequired -> 150 | 402 151 | 152 | Forbidden -> 153 | 403 154 | 155 | NotFound -> 156 | 404 157 | 158 | MethodNotAllowed -> 159 | 405 160 | 161 | NotAcceptable -> 162 | 406 163 | 164 | ProxyAuthenticationRequired -> 165 | 407 166 | 167 | RequestTimeout -> 168 | 408 169 | 170 | Conflict -> 171 | 409 172 | 173 | Gone -> 174 | 410 175 | 176 | LengthRequired -> 177 | 411 178 | 179 | PreconditionFailed -> 180 | 412 181 | 182 | PayloadTooLarge -> 183 | 413 184 | 185 | URITooLong -> 186 | 414 187 | 188 | UnsupportedMediaType -> 189 | 415 190 | 191 | RangeNotSatisfiable -> 192 | 416 193 | 194 | ExpectationFailed -> 195 | 417 196 | 197 | ImATeapot -> 198 | 418 199 | 200 | MisdirectedRequest -> 201 | 421 202 | 203 | UnprocessableEntity -> 204 | 422 205 | 206 | Locked -> 207 | 423 208 | 209 | FailedDependency -> 210 | 424 211 | 212 | TooEarly -> 213 | 425 214 | 215 | UpgradeRequired -> 216 | 426 217 | 218 | PreconditionRequired -> 219 | 428 220 | 221 | TooManyRequests -> 222 | 429 223 | 224 | RequestHeaderFieldsTooLarge -> 225 | 431 226 | 227 | UnavailableForLegalReasons -> 228 | 451 229 | 230 | InternalServerError -> 231 | 500 232 | 233 | NotImplemented -> 234 | 501 235 | 236 | BadGateway -> 237 | 502 238 | 239 | ServiceUnavailable -> 240 | 503 241 | 242 | GatewayTimeout -> 243 | 504 244 | 245 | HTTPVersionNotSupported -> 246 | 505 247 | 248 | VariantAlsoNegotiates -> 249 | 506 250 | 251 | InsufficientStorage -> 252 | 507 253 | 254 | LoopDetected -> 255 | 508 256 | 257 | NotExtended -> 258 | 510 259 | 260 | NetworkAuthenticationRequired -> 261 | 511 262 | 263 | Unofficial code -> 264 | code 265 | 266 | 267 | fromCode : Int -> Status 268 | fromCode code = 269 | case code of 270 | 100 -> 271 | Continue 272 | 273 | 101 -> 274 | SwitchingProtocols 275 | 276 | 102 -> 277 | Processing 278 | 279 | 103 -> 280 | EarlyHints 281 | 282 | 200 -> 283 | StatusOk 284 | 285 | 201 -> 286 | Created 287 | 288 | 202 -> 289 | Accepted 290 | 291 | 203 -> 292 | NonAuthoritativeInformation 293 | 294 | 204 -> 295 | NoContent 296 | 297 | 205 -> 298 | ResetContent 299 | 300 | 206 -> 301 | PartialContent 302 | 303 | 207 -> 304 | MultiStatus 305 | 306 | 208 -> 307 | AlreadyReported 308 | 309 | 226 -> 310 | IMUsed 311 | 312 | 300 -> 313 | MultipleChoices 314 | 315 | 301 -> 316 | MovedPermanently 317 | 318 | 302 -> 319 | Found 320 | 321 | 303 -> 322 | SeeOther 323 | 324 | 304 -> 325 | NotModified 326 | 327 | 305 -> 328 | UseProxy 329 | 330 | 306 -> 331 | SwitchProxy 332 | 333 | 307 -> 334 | TemporaryRedirect 335 | 336 | 308 -> 337 | PermanentRedirect 338 | 339 | 400 -> 340 | BadRequest 341 | 342 | 401 -> 343 | Unauthorized 344 | 345 | 402 -> 346 | PaymentRequired 347 | 348 | 403 -> 349 | Forbidden 350 | 351 | 404 -> 352 | NotFound 353 | 354 | 405 -> 355 | MethodNotAllowed 356 | 357 | 406 -> 358 | NotAcceptable 359 | 360 | 407 -> 361 | ProxyAuthenticationRequired 362 | 363 | 408 -> 364 | RequestTimeout 365 | 366 | 409 -> 367 | Conflict 368 | 369 | 410 -> 370 | Gone 371 | 372 | 411 -> 373 | LengthRequired 374 | 375 | 412 -> 376 | PreconditionFailed 377 | 378 | 413 -> 379 | PayloadTooLarge 380 | 381 | 414 -> 382 | URITooLong 383 | 384 | 415 -> 385 | UnsupportedMediaType 386 | 387 | 416 -> 388 | RangeNotSatisfiable 389 | 390 | 417 -> 391 | ExpectationFailed 392 | 393 | 418 -> 394 | ImATeapot 395 | 396 | 421 -> 397 | MisdirectedRequest 398 | 399 | 422 -> 400 | UnprocessableEntity 401 | 402 | 423 -> 403 | Locked 404 | 405 | 424 -> 406 | FailedDependency 407 | 408 | 425 -> 409 | TooEarly 410 | 411 | 426 -> 412 | UpgradeRequired 413 | 414 | 428 -> 415 | PreconditionRequired 416 | 417 | 429 -> 418 | TooManyRequests 419 | 420 | 431 -> 421 | RequestHeaderFieldsTooLarge 422 | 423 | 451 -> 424 | UnavailableForLegalReasons 425 | 426 | 500 -> 427 | InternalServerError 428 | 429 | 501 -> 430 | NotImplemented 431 | 432 | 502 -> 433 | BadGateway 434 | 435 | 503 -> 436 | ServiceUnavailable 437 | 438 | 504 -> 439 | GatewayTimeout 440 | 441 | 505 -> 442 | HTTPVersionNotSupported 443 | 444 | 506 -> 445 | VariantAlsoNegotiates 446 | 447 | 507 -> 448 | InsufficientStorage 449 | 450 | 508 -> 451 | LoopDetected 452 | 453 | 510 -> 454 | NotExtended 455 | 456 | 511 -> 457 | NetworkAuthenticationRequired 458 | 459 | unofficialCode -> 460 | Unofficial unofficialCode 461 | -------------------------------------------------------------------------------- /src/runner.js: -------------------------------------------------------------------------------- 1 | import * as denoHttp from "https://deno.land/std@0.74.0/http/server.ts"; 2 | import * as path from "https://deno.land/std@0.74.0/path/mod.ts"; 3 | import { parse as parseFlags } from "https://deno.land/std@0.74.0/flags/mod.ts"; 4 | import { config } from "https://deno.land/x/dotenv@v0.5.0/mod.ts"; 5 | import { Pool } from "https://deno.land/x/postgres@v0.4.5/mod.ts"; 6 | import { validateJwt } from "https://deno.land/x/djwt@v1.7/validate.ts"; 7 | import { 8 | makeJwt, 9 | setExpiration, 10 | } from "https://deno.land/x/djwt@v1.7/create.ts"; 11 | import "https://raw.githubusercontent.com/wolfadex/deno_elm_http/master/http-polyfill.js"; 12 | import * as ElmCompiler from "https://deno.land/x/deno_elm_compiler@0.1.0/compiler.ts"; 13 | 14 | config({ safe: true }); 15 | 16 | const tempDirectoriesToRemove = []; 17 | let elmServer = null; 18 | let serverInstance = null; 19 | let databaseConnectionPool = null; 20 | const _setTimeout = globalThis.setTimeout; 21 | const __elm_interop_tasks = new Map(); 22 | let __elm_interop_nextTask = null; 23 | 24 | Object.defineProperty(Object.prototype, "__elm_interop_async", { 25 | set([token, msg, args]) { 26 | // Async version see setTimeout below for execution 27 | __elm_interop_nextTask = [token, msg, args]; 28 | }, 29 | get() { 30 | let ret = __elm_interop_tasks.get(this.token); 31 | __elm_interop_tasks.delete(ret); 32 | return ret; 33 | }, 34 | }); 35 | 36 | globalThis.setTimeout = (callback, time, ...args) => { 37 | // 69 108 109 === Elm 38 | if (time === -69108109 && __elm_interop_nextTask != null) { 39 | const [token, msg, args] = __elm_interop_nextTask; 40 | __elm_interop_nextTask = null; 41 | 42 | Promise.resolve() 43 | .then(async (_) => { 44 | switch (msg) { 45 | case "SERVE": 46 | { 47 | const { databaseConnection, port, certs } = args; 48 | const options = { port }; 49 | 50 | if (certs != null) { 51 | serverInstance = denoHttp.serveTLS({ 52 | ...options, 53 | certFile: certs.certificatePath, 54 | keyFile: certs.keyPath, 55 | }); 56 | } else { 57 | serverInstance = denoHttp.serve(options); 58 | } 59 | 60 | if (databaseConnection != null) { 61 | const POOL_CONNECTIONS = 20; 62 | const { 63 | hostname, 64 | port, 65 | user, 66 | password, 67 | database, 68 | } = databaseConnection; 69 | databaseConnectionPool = new Pool( 70 | { 71 | user, 72 | password, 73 | port, 74 | hostname, 75 | database, 76 | }, 77 | POOL_CONNECTIONS 78 | ); 79 | } 80 | 81 | console.log("Server running on port:", port); 82 | 83 | for await (const req of serverInstance) { 84 | if (elmServer == null) { 85 | console.error( 86 | "Somehow started the server but lost the elm app runtime." 87 | ); 88 | exit(1); 89 | } else { 90 | const decoder = new TextDecoder(); 91 | const decodedBody = decoder.decode( 92 | await Deno.readAll(req.body) 93 | ); 94 | req.elmBody = decodedBody; 95 | elmServer.ports.requestPort.send(req); 96 | } 97 | } 98 | 99 | console.log("Server shutdown"); 100 | } 101 | break; 102 | case "RESPOND": 103 | { 104 | const { headers, ...restOptions } = args.options; 105 | const actualHeaders = new Headers(); 106 | 107 | headers.forEach(function ([key, val]) { 108 | actualHeaders.set(key, val); 109 | }); 110 | args.request.respond({ 111 | ...restOptions, 112 | headers: actualHeaders, 113 | }); 114 | } 115 | break; 116 | case "CLOSE": 117 | serverInstance.close(); 118 | break; 119 | case "PRINT": 120 | console.log(args); 121 | break; 122 | case "DATABASE_QUERY": { 123 | const client = await databaseConnectionPool.connect(); 124 | const result = await client.query(args); 125 | 126 | client.release(); 127 | 128 | return result.rows; 129 | } 130 | case "FILE_SYSTEM_READ": { 131 | const decoder = new TextDecoder("utf-8"); 132 | const fileContent = decoder.decode(await Deno.readFile(args)); 133 | 134 | return fileContent; 135 | } 136 | case "JWT_GENERATE": 137 | return makeJwt({ 138 | ...args, 139 | payload: { 140 | ...args.payload, 141 | exp: setExpiration(args.payload.exp), 142 | }, 143 | }); 144 | case "JWT_VALIDATE": 145 | return validateJwt(args); 146 | default: 147 | console.error(`Error: Unknown server request: "${msg}"`, args); 148 | } 149 | }) 150 | .then((result) => { 151 | __elm_interop_tasks.set(token, { tag: "Ok", result }); 152 | }) 153 | .catch((err) => { 154 | __elm_interop_tasks.set(token, { tag: "Error", error: err }); 155 | }) 156 | .then((_) => { 157 | callback(); 158 | }); 159 | } else { 160 | return _setTimeout(callback, time, ...args); 161 | } 162 | }; 163 | 164 | function showHelp() { 165 | console.log(`elm-server commands and options 166 | 167 | --help Displays this text 168 | start Takes a source Elm file, an optional list of args, and starts the server`); 169 | } 170 | 171 | async function compileElm() { 172 | const sourceFileName = Deno.args[1]; 173 | const absolutePath = path.resolve(sourceFileName); 174 | const extension = path.extname(absolutePath); 175 | 176 | if (extension === ".js") { 177 | // Read compiled JS from file 178 | const jsData = Deno.readFileSync(jsFileName); 179 | const jsText = new TextDecoder("utf-8").decode(jsData); 180 | return jsText; 181 | } else if (extension === ".elm") { 182 | try { 183 | const jsText = await ElmCompiler.compileToString(absolutePath); 184 | return jsText; 185 | } catch (err) { 186 | console.log(err); 187 | exit(1); 188 | } 189 | } else { 190 | console.log( 191 | `Unrecognized source file extension ${extension} (expecting.elm or.js)` 192 | ); 193 | exit(1); 194 | } 195 | } 196 | 197 | async function buildModule(compiledElm, commandLineArgs) { 198 | // Run Elm code to create the 'Elm' object 199 | const globalEval = eval; 200 | globalEval(compiledElm); 201 | 202 | // Collect flags to pass to Elm program 203 | const flags = {}; 204 | flags["arguments"] = parseFlags(commandLineArgs); 205 | switch (Deno.build.os) { 206 | case "mac": 207 | case "darwin": 208 | case "linux": 209 | flags["platform"] = { 210 | type: "posix", 211 | name: Deno.build.os, 212 | }; 213 | break; 214 | case "windows": 215 | flags["platform"] = { type: "windows" }; 216 | break; 217 | default: 218 | console.log("Unrecognized OS '" + Deno.build.os + "'"); 219 | exit(1); 220 | } 221 | flags["environment"] = Deno.env.toObject(); 222 | // flags["workingDirectory"] = Deno.cwd(); 223 | 224 | // Get Elm program object 225 | var module = findNestedModule(globalThis["Elm"]); 226 | while (!("init" in module)) { 227 | module = findNestedModule(module); 228 | } 229 | 230 | return [module, flags]; 231 | } 232 | 233 | function exit(code) { 234 | // First, clean up any temp directories created while running the script 235 | for (const directoryPath of tempDirectoriesToRemove) { 236 | try { 237 | Deno.removeSync(directoryPath, { recursive: true }); 238 | } catch (error) { 239 | // Ignore any errors that may occur when attempting to delete a 240 | // temporary directory - likely the directory was just deleted 241 | // explicitly, and even if it's some other issue (directory 242 | // somehow became read-only, in use because an antivirus program is 243 | // currently checking it etc.) it's not generally the end of the 244 | // world if the odd temp directory doesn't get deleted. (Script 245 | // authors who need to make sure sensitive data gets deleted can 246 | // always call Directory.obliterate in their script and check for 247 | // any errors resulting from it.) 248 | continue; 249 | } 250 | } 251 | 252 | if (serverInstance != null) { 253 | serverInstance.close(); 254 | } 255 | 256 | // Finally, actually exit 257 | Deno.exit(code); 258 | } 259 | 260 | function createTemporaryDirectory() { 261 | // Create a new temp directory 262 | const directoryPath = Deno.makeTempDirSync(); 263 | // Add it to the list of temp directories to remove when the script has 264 | // finished executing 265 | tempDirectoriesToRemove.push(directoryPath); 266 | return directoryPath; 267 | } 268 | 269 | function findNestedModule(obj) { 270 | const nestedModules = Object.values(obj); 271 | if (nestedModules.length != 1) { 272 | console.log( 273 | `Expected exactly 1 nested module, found ${nestedModules.length}` 274 | ); 275 | exit(1); 276 | } 277 | return nestedModules[0]; 278 | } 279 | 280 | async function main() { 281 | switch (Deno.args[0]) { 282 | case "start": 283 | { 284 | const compiledElm = await compileElm(); 285 | const commandLineArgs = Deno.args.slice(2); 286 | const [module, flags] = await buildModule(compiledElm, commandLineArgs); 287 | elmServer = module.init({ flags }); 288 | } 289 | break; 290 | case "--help": 291 | showHelp(); 292 | break; 293 | default: 294 | console.log( 295 | "Run 'elm-server --help' for a list of commands or visit https://github.com/wolfadex/elm-server" 296 | ); 297 | exit(1); 298 | break; 299 | } 300 | } 301 | 302 | main(); 303 | --------------------------------------------------------------------------------