Add prototype for withSession helper.

examples/pokedex/src/Page/Greet.elm

@@ -1,17 +1,24 @@
 module Page.Greet exposing (Data, Model, Msg, page)
 
-import CookieParser
+import Codec exposing (Codec)
 import DataSource exposing (DataSource)
-import Dict
+import DataSource.Http
+import Dict exposing (Dict)
 import Head
 import Head.Seo as Seo
 import Html
 import Html.Attributes as Attr
+import Json.Decode
+import Json.Encode
+import OptimizedDecoder
 import Page exposing (Page, PageWithState, StaticPayload)
 import Pages.PageUrl exposing (PageUrl)
+import Pages.Secrets as Secrets
 import Pages.Url
-import Server.Request as Request
+import Server.Request as Request exposing (Request)
-import Server.Response
+import Server.Response exposing (Response)
+import Server.SetCookie as SetCookie
+import Session exposing (Session)
 import Shared
 import Time
 import View exposing (View)
@@ -38,36 +45,221 @@ page =
         |> Page.buildNoState { view = view }
 
 
+withSession :
+    { name : String
+    , secrets : Secrets.Value (List String)
+    , sameSite : String
+    }
+    -> Session.Decoder decoded
+    -> (DataSource (Result String decoded) -> DataSource ( Session.SessionUpdate, Response data ))
+    -> Request (DataSource (Response data))
+withSession config decoder toRequest =
+    Request.cookie config.name
+        |> Request.map
+            (\maybeSessionCookie ->
+                --DataSource.succeed
+                --    (case maybeSessionCookie of
+                --        Just sessionCookie ->
+                --            Debug.todo ""
+                --
+                --        Nothing ->
+                --            Debug.todo ""
+                --    )
+                let
+                    result : Result String decoded
+                    result =
+                        --Err ""
+                        case maybeSessionCookie of
+                            Nothing ->
+                                Err "TODO"
+
+                            Just sessionCookie ->
+                                OptimizedDecoder.decodeString decoder sessionCookie
+                                    |> Result.mapError Json.Decode.errorToString
+
+                    --decrypted : DataSource (Dict String Json.Decode.Value)
+                    decrypted =
+                        case maybeSessionCookie of
+                            Just sessionCookie ->
+                                decrypt decoder sessionCookie
+                                    |> DataSource.map Ok
+
+                            Nothing ->
+                                Err "TODO"
+                                    |> DataSource.succeed
+
+                    decryptedFull =
+                        maybeSessionCookie
+                            |> Maybe.map
+                                (\sessionCookie -> decrypt (OptimizedDecoder.dict OptimizedDecoder.value) sessionCookie)
+                            |> Maybe.withDefault (DataSource.succeed Dict.empty)
+                in
+                decryptedFull
+                    |> DataSource.andThen
+                        (\cookieDict ->
+                            DataSource.andThen
+                                (\( sessionUpdate, response ) ->
+                                    let
+                                        encodedCookie =
+                                            Session.setValues sessionUpdate cookieDict
+                                    in
+                                    DataSource.map2
+                                        (\encoded originalCookieValues ->
+                                            response
+                                                |> Server.Response.withSetCookieHeader
+                                                    (SetCookie.setCookie config.name encoded
+                                                        |> SetCookie.httpOnly
+                                                        |> SetCookie.withPath "/"
+                                                     -- TODO set expiration time
+                                                     -- TODO do I need to encrypt the session expiration as part of it
+                                                     -- TODO should I update the expiration time every time?
+                                                     --|> SetCookie.withExpiration (Time.millisToPosix 100000000000)
+                                                    )
+                                        )
+                                        (encrypt config.secrets encodedCookie)
+                                        decryptedFull
+                                )
+                                (toRequest decrypted)
+                        )
+            )
+
+
+encrypt : Secrets.Value (List String) -> Json.Encode.Value -> DataSource.DataSource String
+encrypt secrets input =
+    let
+        decoder : OptimizedDecoder.Decoder String
+        decoder =
+            OptimizedDecoder.string
+    in
+    DataSource.Http.request
+        (secrets
+            |> Secrets.map
+                (\secretList ->
+                    { url = "port://encrypt"
+                    , method = "GET"
+                    , headers = []
+
+                    -- TODO pass through secrets here
+                    , body = DataSource.Http.jsonBody input
+                    }
+                )
+        )
+        decoder
+
+
+
+--decrypt : String -> DataSource.DataSource (Dict String Json.Decode.Value)
+
+
+decrypt : OptimizedDecoder.Decoder a -> String -> DataSource a
+decrypt decoder input =
+    --let
+    --    decoder : OptimizedDecoder.Decoder (Dict String Json.Decode.Value)
+    --    decoder =
+    --        OptimizedDecoder.dict OptimizedDecoder.value
+    --in
+    DataSource.Http.request
+        (Secrets.succeed
+            { url = "port://decrypt"
+            , method = "GET"
+            , headers = []
+            , body = DataSource.Http.jsonBody (Json.Encode.string input)
+            }
+        )
+        decoder
+
+
+keys =
+    { userId = ( "userId", Codec.int )
+    }
+
+
 data : RouteParams -> Request.Request (DataSource (Server.Response.Response Data))
 data routeParams =
     Request.oneOf
-        [ Request.map2 Data
+        [ --Request.map2 Data
-            (Request.expectQueryParam "name")
+          --    (Request.expectQueryParam "name")
-            Request.requestTime
+          --    Request.requestTime
-            |> Request.map
+          --    |> Request.map
-                (\requestData ->
+          --        (\requestData ->
-                    requestData
+          --            requestData
-                        |> Server.Response.render
+          --                |> Server.Response.render
-                        |> Server.Response.withHeader
+          --                |> Server.Response.withHeader
-                            "x-greeting"
+          --                    "x-greeting"
-                            ("hello there " ++ requestData.username ++ "!")
+          --                    ("hello there " ++ requestData.username ++ "!")
-                        |> DataSource.succeed
+          --                |> DataSource.succeed
-                )
+          --        )
-        , Request.map2 Data
+          --, Request.map2 Data
-            (Request.expectCookie "username")
+          --    (Request.expectCookie "username")
-            Request.requestTime
+          --    Request.requestTime
-            |> Request.map
+          --    |> Request.map
-                (\requestData ->
+          --        (\requestData ->
-                    requestData
+          --            requestData
-                        |> Server.Response.render
+          --                |> Server.Response.render
-                        |> Server.Response.withHeader
+          --                |> Server.Response.withHeader
-                            "x-greeting"
+          --                    "x-greeting"
-                            ("hello " ++ requestData.username ++ "!")
+          --                    ("hello " ++ requestData.username ++ "!")
-                        |> DataSource.succeed
+          --                |> DataSource.succeed
-                )
+          --        ),
-        , Request.succeed
+          --, withSession
-            (DataSource.succeed
+          --    { name = "__session"
-                (Server.Response.temporaryRedirect "/login")
+          --    , secrets =
+          --        Secrets.succeed
+          --            (\sessionSecret -> [ sessionSecret ])
+          --            |> Secrets.with "SESSION_SECRET"
+          --    , sameSite = "lax" -- TODO custom type
+          --    , codec =
+          --        -- TODO use custom codec API, allowing you to retrieve fields, decode them, and set fields with flash
+          --        Codec.object identity
+          --            |> Codec.field "userId" identity Codec.string
+          --            |> Codec.buildObject
+          --    }
+          --    (\userIdResult ->
+          --        case userIdResult of
+          --            Err error ->
+          --                Debug.todo ""
+          --
+          --            Ok userId ->
+          --                Request.succeed
+          --                    (DataSource.succeed
+          --                        ( userId, Server.Response.temporaryRedirect "/login" )
+          --                    )
+          --    )
+          withSession
+            { name = "mysession"
+            , secrets =
+                Secrets.succeed
+                    (\sessionSecret -> [ sessionSecret ])
+                    |> Secrets.with "SESSION_SECRET"
+            , sameSite = "lax" -- TODO custom type
+            }
+            (OptimizedDecoder.field "userId" OptimizedDecoder.int)
+            (\decryptSession ->
+                decryptSession
+                    |> DataSource.andThen
+                        (\userIdResult ->
+                            case userIdResult of
+                                Err error ->
+                                    DataSource.succeed
+                                        ( Session.oneUpdate "userId" (Json.Encode.int 456)
+                                          --, Server.Response.temporaryRedirect "/login"
+                                        , { username = "NO USER"
+                                          , requestTime = Time.millisToPosix 0
+                                          }
+                                            |> Server.Response.render
+                                        )
+
+                                Ok userId ->
+                                    DataSource.succeed
+                                        ( --Session.oneUpdate "userId" (Json.Encode.int 456)
+                                          Session.noUpdates
+                                        , --Server.Response.temporaryRedirect "/login"
+                                          { username = String.fromInt userId
+                                          , requestTime = Time.millisToPosix 0
+                                          }
+                                            |> Server.Response.render
+                                        )
+                        )
             )
         ]
 

generator/src/request-cache.js

@@ -55,7 +55,66 @@ function lookupOrPerform(mode, rawRequest, hasFsAccess) {
         portDataSourceFound = true;
       } catch (e) {}
 
-      if (request.url.startsWith("port://")) {
+      if (request.url === "port://encrypt") {
+        const cookie = require("cookie-signature");
+        console.log(
+          "@@@signing",
+          rawRequest.body.args[0],
+          typeof rawRequest.body.args[0]
+        );
+        console.log(
+          "signed",
+          cookie.sign(
+            JSON.stringify(rawRequest.body.args[0], null, 0),
+            "abcdefg"
+          )
+        );
+        try {
+          await fs.promises.writeFile(
+            responsePath,
+            JSON.stringify(
+              cookie.sign(
+                JSON.stringify(rawRequest.body.args[0], null, 0),
+                "abcdefg"
+              )
+            )
+          );
+          resolve(responsePath);
+        } catch (e) {
+          reject({
+            title: "DataSource.Port Error",
+            message:
+              e.toString() +
+              e.stack +
+              "\n\n" +
+              JSON.stringify(rawRequest, null, 2),
+          });
+        }
+      } else if (request.url === "port://decrypt") {
+        const cookie = require("cookie-signature");
+        console.log("@@@[0]", rawRequest.body.args[0]);
+        try {
+          console.log(
+            "unsigned",
+            cookie.unsign(rawRequest.body.args[0], "abcdefg")
+          );
+          // TODO if unsign returns `false`, need to have an `Err` in Elm because decryption failed
+          await fs.promises.writeFile(
+            responsePath,
+            cookie.unsign(rawRequest.body.args[0], "abcdefg")
+          );
+          resolve(responsePath);
+        } catch (e) {
+          reject({
+            title: "DataSource.Port Error",
+            message:
+              e.toString() +
+              e.stack +
+              "\n\n" +
+              JSON.stringify(rawRequest, null, 2),
+          });
+        }
+      } else if (request.url.startsWith("port://")) {
         try {
           const portName = request.url.replace(/^port:\/\//, "");
           // console.time(JSON.stringify(request.url));

package-lock.json

@@ -14,6 +14,7 @@
         "commander": "8.3.0",
         "connect": "^3.7.0",
         "cookie": "^0.4.1",
+        "cookie-signature": "^1.1.0",
         "cross-spawn": "7.0.3",
         "devcert": "^1.2.0",
         "elm-doc-preview": "^5.0.5",
@@ -1238,9 +1239,12 @@
       }
     },
     "node_modules/cookie-signature": {
-      "version": "1.0.6",
+      "version": "1.1.0",
-      "resolved": "https://registry.npmjs.org/cookie-signature/-/cookie-signature-1.0.6.tgz",
+      "resolved": "https://registry.npmjs.org/cookie-signature/-/cookie-signature-1.1.0.tgz",
-      "integrity": "sha1-4wOogrNCzD7oylE6eZmXNNqzriw="
+      "integrity": "sha512-Alvs19Vgq07eunykd3Xy2jF0/qSNv2u7KDbAek9H5liV1UMijbqFs5cycZvv5dVsvseT/U4H8/7/w8Koh35C4A==",
+      "engines": {
+        "node": ">=6.6.0"
+      }
     },
     "node_modules/core-util-is": {
       "version": "1.0.2",
@@ -2097,6 +2101,11 @@
         "async-limiter": "~1.0.0"
       }
     },
+    "node_modules/express/node_modules/cookie-signature": {
+      "version": "1.0.6",
+      "resolved": "https://registry.npmjs.org/cookie-signature/-/cookie-signature-1.0.6.tgz",
+      "integrity": "sha1-4wOogrNCzD7oylE6eZmXNNqzriw="
+    },
     "node_modules/express/node_modules/qs": {
       "version": "6.9.6",
       "resolved": "https://registry.npmjs.org/qs/-/qs-6.9.6.tgz",
@@ -6728,9 +6737,9 @@
       "integrity": "sha512-ZwrFkGJxUR3EIoXtO+yVE69Eb7KlixbaeAWfBQB9vVsNn/o+Yw69gBWSSDK825hQNdN+wF8zELf3dFNl/kxkUA=="
     },
     "cookie-signature": {
-      "version": "1.0.6",
+      "version": "1.1.0",
-      "resolved": "https://registry.npmjs.org/cookie-signature/-/cookie-signature-1.0.6.tgz",
+      "resolved": "https://registry.npmjs.org/cookie-signature/-/cookie-signature-1.1.0.tgz",
-      "integrity": "sha1-4wOogrNCzD7oylE6eZmXNNqzriw="
+      "integrity": "sha512-Alvs19Vgq07eunykd3Xy2jF0/qSNv2u7KDbAek9H5liV1UMijbqFs5cycZvv5dVsvseT/U4H8/7/w8Koh35C4A=="
     },
     "core-util-is": {
       "version": "1.0.2",
@@ -7401,6 +7410,11 @@
         "vary": "~1.1.2"
       },
       "dependencies": {
+        "cookie-signature": {
+          "version": "1.0.6",
+          "resolved": "https://registry.npmjs.org/cookie-signature/-/cookie-signature-1.0.6.tgz",
+          "integrity": "sha1-4wOogrNCzD7oylE6eZmXNNqzriw="
+        },
         "qs": {
           "version": "6.9.6",
           "resolved": "https://registry.npmjs.org/qs/-/qs-6.9.6.tgz",

package.json

@@ -28,6 +28,7 @@
     "commander": "8.3.0",
     "connect": "^3.7.0",
     "cookie": "^0.4.1",
+    "cookie-signature": "^1.1.0",
     "cross-spawn": "7.0.3",
     "devcert": "^1.2.0",
     "elm-doc-preview": "^5.0.5",

src/Server/Request.elm

@@ -11,6 +11,7 @@ module Server.Request exposing
     , expectFormPost
     , File, expectMultiPartFormPost
     , errorsToString, errorToString, getDecoder
+    , andThen
     )
 
 {-|

src/Session.elm

@@ -0,0 +1,61 @@
+module Session exposing (..)
+
+import Codec exposing (Codec)
+import Dict exposing (Dict)
+import Json.Decode
+import Json.Encode
+import OptimizedDecoder
+
+
+type Session decoded
+    = Session decoded
+
+
+type alias Decoder decoded =
+    OptimizedDecoder.Decoder decoded
+
+
+type SessionUpdate
+    = SessionUpdate (Dict String Json.Encode.Value)
+
+
+noUpdates : SessionUpdate
+noUpdates =
+    SessionUpdate Dict.empty
+
+
+oneUpdate : String -> Json.Encode.Value -> SessionUpdate
+oneUpdate string value =
+    SessionUpdate (Dict.singleton string value)
+
+
+type NotLoadedReason
+    = NoCookies
+    | MissingHeaders
+
+
+succeed : constructor -> Decoder constructor
+succeed constructor =
+    constructor
+        |> OptimizedDecoder.succeed
+
+
+decoder =
+    -- TODO have a way to commit updates using this as the starting point
+    OptimizedDecoder.dict OptimizedDecoder.value
+
+
+setValues : SessionUpdate -> Dict String Json.Decode.Value -> Json.Encode.Value
+setValues (SessionUpdate dict) original =
+    Dict.union dict original
+        |> Dict.toList
+        |> Json.Encode.object
+
+
+
+--|> Decoder
+
+
+get : ( String, Codec a ) -> Result String a
+get ( string, codec ) =
+    Err "TODO"