elm-ssr 0.1.0 → 0.3.0

package/bin/elm-ssr.mjs

@@ -2,7 +2,7 @@
 
 import { readFile } from "node:fs/promises";
 import { resolve } from "node:path";
-import { createExampleScaffold } from "../lib/scaffold.mjs";
+import { createAppScaffold } from "../lib/scaffold.mjs";
 import { readWorkspaceConfig } from "../lib/workspace.mjs";
 import { build } from "../lib/build.mjs";
 import { migrate } from "../lib/migrate.mjs";
@@ -48,7 +48,8 @@ const printHelp = () => {
   build         Generate wrapper modules and compile configured Elm SSR apps
   compress      Pre-compress island and app bundles using Gzip for faster edge delivery
   dev           Build and start wrangler dev using the current workspace config
-  new <name>    Create a new example app and register it in elm-ssr.config.json
+  new <name>    Create a new app at <workspace>/<name>/ (or <workspace>/<subdir>/<name>/
+                with --in <subdir>) and register it in elm-ssr.config.json
   routes        Print configured apps and their public modules
   info          Print current workspace package and configured app names
   migrate ...   Apply / revert / inspect SQL migrations (see: elm-ssr migrate --help)
@@ -72,11 +73,15 @@ switch (command) {
     const name = args[1];
 
     if (!name) {
-      console.error("Usage: elm-ssr new <name>");
+      console.error("Usage: elm-ssr new <name> [--in <subdir>]");
+      console.error("  Default location: <workspace>/<name>/");
+      console.error("  Use --in apps to place it under <workspace>/apps/<name>/, etc.");
       process.exit(1);
     }
 
-    const created = await createExampleScaffold(rootPath, name);
+    const subdir = findFlagValue("--in");
+    const appRoot = subdir ? `${subdir.replace(/\/+$/, "")}/${name}` : name;
+    const created = await createAppScaffold(rootPath, name, { root: appRoot });
     console.log(`Created ${created.name} at ${created.root}`);
     break;
   }

package/elm-src/ElmSsr/Action.elm

@@ -2,7 +2,8 @@ module ElmSsr.Action exposing
     ( Action
     , succeed, fail, redirect, json
     , map, andThen, fromLoader
-    , Effect, Step(..), step, encodeStep
+    , Cookie, SameSite(..), setCookie, clearCookie, defaultCookie, sessionCookie
+    , Effect, Step(..), step, collectCookies, encodeStep, encodeCookies
     )
 
 {-| An `Action` describes what should happen in response to a non-GET request
@@ -32,12 +33,20 @@ redirects (the Post/Redirect/Get pattern):
 @docs map, andThen, fromLoader
 
 
+# Cookies
+
+Attach `Set-Cookie` headers to any action's response (including redirects and
+JSON responses). The Worker serializes the attributes for you.
+
+@docs Cookie, SameSite, setCookie, clearCookie, defaultCookie, sessionCookie
+
+
 # Runtime interpretation
 
 Used by the elm-ssr runtime to drive an action. Application authors do not need
 these.
 
-@docs Effect, Step, step, encodeStep
+@docs Effect, Step, step, collectCookies, encodeStep, encodeCookies
 
 -}
 
@@ -53,6 +62,7 @@ type Action a
     | Redirect String
     | JsonResult Encode.Value
     | Pending Effect (Decode.Value -> Action a)
+    | WithCookies (List Cookie) (Action a)
 
 
 {-| A single side effect the Worker runs, addressed by `kind`. Shared with
@@ -61,6 +71,136 @@ type alias Effect =
     Loader.Effect
 
 
+{-| `SameSite` policy for a cookie. Maps to the `SameSite=` attribute. -}
+type SameSite
+    = Lax
+    | Strict
+    | None
+
+
+{-| A cookie to attach to the response. Build one with
+[`defaultCookie`](#defaultCookie) and override the attributes you care about.
+-}
+type alias Cookie =
+    { name : String
+    , value : String
+    , maxAge : Maybe Int
+    , expires : Maybe String
+    , domain : Maybe String
+    , path : Maybe String
+    , secure : Bool
+    , httpOnly : Bool
+    , sameSite : Maybe SameSite
+    }
+
+
+{-| A cookie with sensible defaults: `path=/`, no other attributes set. Override
+fields with record update syntax.
+
+    Action.setCookie
+        { defaultCookie "session" sessionId | httpOnly = True, secure = True, maxAge = Just (60 * 60 * 24 * 7) }
+        (Action.redirect "/dashboard")
+
+-}
+defaultCookie : String -> String -> Cookie
+defaultCookie name value =
+    { name = name
+    , value = value
+    , maxAge = Nothing
+    , expires = Nothing
+    , domain = Nothing
+    , path = Just "/"
+    , secure = False
+    , httpOnly = False
+    , sameSite = Nothing
+    }
+
+
+{-| A cookie hardened for session use: `HttpOnly` (JS can't read it),
+`Secure` (HTTPS-only), `SameSite=Lax` (sent on top-level navigations,
+blocked on cross-site sub-requests), `Path=/`, and a 7-day `Max-Age`.
+
+Use this for anything that grants authority — session IDs, auth tokens —
+and override only what you need.
+
+    Action.redirect "/dashboard"
+        |> Action.setCookie (Action.sessionCookie "session" sessionId)
+
+To use a stricter `SameSite=Strict`, or shorter/longer lifetime:
+
+    Action.sessionCookie "session" sid
+        |> (\c -> { c | sameSite = Just Action.Strict, maxAge = Just (60 * 30) })
+        |> (\c -> Action.setCookie c (Action.redirect "/dashboard"))
+
+If you are testing locally over plain HTTP, you'll need to set `secure = False`
+on the cookie — modern browsers ignore `Secure` cookies on `http://`.
+
+-}
+sessionCookie : String -> String -> Cookie
+sessionCookie name value =
+    { name = name
+    , value = value
+    , maxAge = Just (60 * 60 * 24 * 7)
+    , expires = Nothing
+    , domain = Nothing
+    , path = Just "/"
+    , secure = True
+    , httpOnly = True
+    , sameSite = Just Lax
+    }
+
+
+{-| Attach a `Set-Cookie` header to the action's response. Stackable — call
+multiple times to set multiple cookies. Works with any terminal step (success,
+fail, redirect, JSON) and is preserved through `map`/`andThen`.
+
+    Action.fromLoader (createSession email)
+        |> Action.andThen
+            (\sessionId ->
+                Action.redirect "/dashboard"
+                    |> Action.setCookie
+                        ({ defaultCookie "session" sessionId
+                            | httpOnly = True
+                            , secure = True
+                            , sameSite = Just Lax
+                            , maxAge = Just (60 * 60 * 24 * 7)
+                         })
+            )
+
+-}
+setCookie : Cookie -> Action a -> Action a
+setCookie cookie action =
+    case action of
+        WithCookies cookies inner ->
+            WithCookies (cookies ++ [ cookie ]) inner
+
+        _ ->
+            WithCookies [ cookie ] action
+
+
+{-| Clear a cookie by setting `Max-Age=0`. Honors the same `path`/`domain` you
+used to set it — pass them in if you scoped the original cookie that way.
+
+    Action.redirect "/login"
+        |> Action.clearCookie { name = "session", path = Just "/", domain = Nothing }
+
+-}
+clearCookie : { name : String, path : Maybe String, domain : Maybe String } -> Action a -> Action a
+clearCookie config action =
+    setCookie
+        { name = config.name
+        , value = ""
+        , maxAge = Just 0
+        , expires = Nothing
+        , domain = config.domain
+        , path = config.path
+        , secure = False
+        , httpOnly = False
+        , sameSite = Nothing
+        }
+        action
+
+
 {-| An action that resolves to a value with no further work. -}
 succeed : a -> Action a
 succeed =
@@ -104,6 +244,9 @@ map fn action =
         Pending effect continue ->
             Pending effect (\value -> map fn (continue value))
 
+        WithCookies cookies inner ->
+            WithCookies cookies (map fn inner)
+
 
 {-| Sequence actions: run a second step that depends on the first's result.
 Effects run one after the other, each completing before the next begins. -}
@@ -125,6 +268,9 @@ andThen fn action =
         Pending effect continue ->
             Pending effect (\value -> andThen fn (continue value))
 
+        WithCookies cookies inner ->
+            WithCookies cookies (andThen fn inner)
+
 
 {-| Lift a [`Loader`](./Loader.elm) into an action so its effects run as part of
 the action. This is how an action does server work (fetch, KV, D1, …) before
@@ -152,7 +298,9 @@ type Step a
     | Await Effect (Decode.Value -> Action a)
 
 
-{-| Inspect the next step of an action. -}
+{-| Inspect the next step of an action. `WithCookies` wrappers are skipped —
+use [`collectCookies`](#collectCookies) first if you need the attached cookies.
+-}
 step : Action a -> Step a
 step action =
     case action of
@@ -171,16 +319,51 @@ step action =
         Pending effect continue ->
             Await effect continue
 
+        WithCookies _ inner ->
+            step inner
+
 
-{-| Encode a terminal step for the Worker runtime. `Await` is never encoded —
-the runtime runs its effect first — so it is reported defensively as an error. -}
-encodeStep : (a -> Encode.Value) -> Step a -> Encode.Value
-encodeStep encoder step_ =
+{-| Strip the top-level `WithCookies` wrappers and return the accumulated
+cookies plus the unwrapped action. Used by the runtime so terminal steps can
+carry `Set-Cookie` headers.
+-}
+collectCookies : Action a -> ( List Cookie, Action a )
+collectCookies action =
+    case action of
+        WithCookies cookies inner ->
+            let
+                ( more, base ) =
+                    collectCookies inner
+            in
+            ( cookies ++ more, base )
+
+        _ ->
+            ( [], action )
+
+
+{-| JSON-encode a list of cookies in the shape the Worker runtime expects.
+Used internally; exposed for cases that build a terminal response by hand
+(e.g. error responses from the runtime). -}
+encodeCookies : List Cookie -> Encode.Value
+encodeCookies cookies =
+    Encode.list encodeCookie cookies
+
+
+{-| Encode a terminal step plus any attached `Set-Cookie`s for the Worker
+runtime. `Await` is never encoded — the runtime runs its effect first — so it
+is reported defensively as an error. -}
+encodeStep : List Cookie -> (a -> Encode.Value) -> Step a -> Encode.Value
+encodeStep cookies encoder step_ =
+    let
+        cookieField =
+            ( "cookies", encodeCookies cookies )
+    in
     case step_ of
         Resolved value ->
             Encode.object
                 [ ( "kind", Encode.string "resolved" )
                 , ( "value", encoder value )
+                , cookieField
                 ]
 
         Errored status message ->
@@ -188,18 +371,21 @@ encodeStep encoder step_ =
                 [ ( "kind", Encode.string "errored" )
                 , ( "status", Encode.int status )
                 , ( "message", Encode.string message )
+                , cookieField
                 ]
 
         Moved url ->
             Encode.object
                 [ ( "kind", Encode.string "redirect" )
                 , ( "url", Encode.string url )
+                , cookieField
                 ]
 
         SentJson value ->
             Encode.object
                 [ ( "kind", Encode.string "json" )
                 , ( "value", value )
+                , cookieField
                 ]
 
         Await _ _ ->
@@ -207,4 +393,43 @@ encodeStep encoder step_ =
                 [ ( "kind", Encode.string "errored" )
                 , ( "status", Encode.int 500 )
                 , ( "message", Encode.string "Action step was not resolved before encoding." )
+                , cookieField
                 ]
+
+
+encodeCookie : Cookie -> Encode.Value
+encodeCookie cookie =
+    Encode.object
+        [ ( "name", Encode.string cookie.name )
+        , ( "value", Encode.string cookie.value )
+        , ( "maxAge", encodeMaybe Encode.int cookie.maxAge )
+        , ( "expires", encodeMaybe Encode.string cookie.expires )
+        , ( "domain", encodeMaybe Encode.string cookie.domain )
+        , ( "path", encodeMaybe Encode.string cookie.path )
+        , ( "secure", Encode.bool cookie.secure )
+        , ( "httpOnly", Encode.bool cookie.httpOnly )
+        , ( "sameSite", encodeMaybe encodeSameSite cookie.sameSite )
+        ]
+
+
+encodeMaybe : (a -> Encode.Value) -> Maybe a -> Encode.Value
+encodeMaybe encoder value =
+    case value of
+        Just inner ->
+            encoder inner
+
+        Nothing ->
+            Encode.null
+
+
+encodeSameSite : SameSite -> Encode.Value
+encodeSameSite sameSite =
+    case sameSite of
+        Lax ->
+            Encode.string "lax"
+
+        Strict ->
+            Encode.string "strict"
+
+        None ->
+            Encode.string "none"

package/elm-src/ElmSsr/Island/Sse.elm

@@ -0,0 +1,151 @@
+port module ElmSsr.Island.Sse exposing
+    ( Event, Error(..)
+    , open, close
+    , events, errors, match
+    )
+
+{-| Server-Sent Events subscription for islands.
+
+The browser opens an `EventSource` per URL; the Worker streams
+`text/event-stream` from a route built with `createSseStream` (see the
+TS-side `elm-ssr/sse` subpath). Multiple subscriptions to the same URL share
+a single underlying connection.
+
+Lifecycle:
+  - Open the stream in `init` (or any `update` branch) with [`open url`](#open).
+  - Receive raw frames via [`events`](#events) in `subscriptions`; route them
+    by URL with [`match`](#match) plus your decoder.
+  - Optionally observe connection errors via [`errors`](#errors).
+  - Close with [`close url`](#close) when you no longer need the stream;
+    SPA navigation closes them automatically for non-persistent islands.
+
+A minimal island:
+
+    type Msg
+        = GotEvent Event
+        | NoOp
+
+
+    init flags =
+        ( { time = "" }, Sse.open "/__elm-ssr/live" )
+
+
+    subscriptions _ =
+        Sse.events GotEvent
+
+
+    update msg model =
+        case msg of
+            GotEvent event ->
+                case Sse.match "/__elm-ssr/live" tickDecoder event of
+                    Just (Ok tick) ->
+                        ( { model | time = tick.time }, Cmd.none )
+
+                    _ ->
+                        ( model, Cmd.none )
+
+            NoOp ->
+                ( model, Cmd.none )
+
+
+# Types
+
+@docs Event, Error
+
+
+# Opening and closing
+
+@docs open, close
+
+
+# Receiving
+
+@docs events, errors, match
+
+-}
+
+import Json.Decode as Decode exposing (Decoder)
+
+
+{-| A raw SSE message. `data` is the unparsed string payload — use
+[`match`](#match) plus a decoder to turn it into a typed value.
+-}
+type alias Event =
+    { url : String, data : String }
+
+
+{-| Why an SSE callback might fail. -}
+type Error
+    = DecodeError String
+    | NetworkError String
+
+
+port sseOpen : String -> Cmd msg
+
+
+port sseClose : String -> Cmd msg
+
+
+port sseEventIn : (Event -> msg) -> Sub msg
+
+
+port sseErrorIn : ({ url : String, message : String } -> msg) -> Sub msg
+
+
+{-| Open (or reuse) an SSE connection to a URL. Idempotent — opening the same
+URL twice does not open a second connection. -}
+open : String -> Cmd msg
+open url =
+    sseOpen url
+
+
+{-| Close the SSE connection for a URL. Idempotent. -}
+close : String -> Cmd msg
+close url =
+    sseClose url
+
+
+{-| Subscribe to every SSE message across every open stream. Filter by URL in
+your `update` (the [`match`](#match) helper is the convenient way). -}
+events : (Event -> msg) -> Sub msg
+events toMsg =
+    sseEventIn toMsg
+
+
+{-| Subscribe to connection errors (`onerror` events from `EventSource`).
+The browser auto-reconnects after these — this is informational. -}
+errors : ({ url : String, message : String } -> msg) -> Sub msg
+errors toMsg =
+    sseErrorIn toMsg
+
+
+{-| If this event is for `url`, decode its `data` with `decoder`. Returns
+`Nothing` for a different URL so the caller can `Maybe`-pattern-match in
+`update` without nested `case`s.
+
+    update msg model =
+        case msg of
+            GotEvent event ->
+                case Sse.match "/__elm-ssr/live" tickDecoder event of
+                    Just (Ok tick) ->
+                        ( { model | tick = tick }, Cmd.none )
+
+                    Just (Err _) ->
+                        ( model, Cmd.none )
+
+                    Nothing ->
+                        ( model, Cmd.none )
+
+-}
+match : String -> Decoder a -> Event -> Maybe (Result Error a)
+match url decoder event =
+    if event.url == url then
+        case Decode.decodeString decoder event.data of
+            Ok value ->
+                Just (Ok value)
+
+            Err err ->
+                Just (Err (DecodeError (Decode.errorToString err)))
+
+    else
+        Nothing

package/elm-src/ElmSsr/Loader.elm

@@ -6,7 +6,9 @@ module ElmSsr.Loader exposing
     , cacheGet, cachePut
     , query, queryOne, execute
     , env
+    , getCookie
     , enqueue
+    , session, csrfToken, setSession, clearSession
     , Effect, Step(..), step, encodeEffect
     )
 
@@ -30,9 +32,19 @@ fully typed end to end.
 @docs cacheGet, cachePut
 @docs query, queryOne, execute
 @docs env
+@docs getCookie
 @docs enqueue
 
 
+# Sessions
+
+These require the TS-side `sessionMiddleware` + `sessionEffects(runner)` to be
+wired in the Worker. Without them the effects fail with a clear message at
+request time.
+
+@docs session, csrfToken, setSession, clearSession
+
+
 # Runtime interpretation
 
 These are used by the elm-ssr runtime to drive a loader. Application authors do
@@ -204,6 +216,24 @@ env name =
         (\result -> resumeFetchJson (Decode.nullable Decode.string) result)
 
 
+{-| Read a cookie from the incoming request by name. Returns `Nothing` if the
+cookie is not present (or no `Cookie` header was sent).
+
+    sessionToken : Loader (Maybe String)
+    sessionToken =
+        Loader.getCookie "session"
+
+The Worker parses the `Cookie` header for you. To *set* a cookie on the
+response, use `ElmSsr.Action.setCookie` from inside an `Action`.
+-}
+getCookie : String -> Loader (Maybe String)
+getCookie name =
+    Pending
+        { kind = "cookie", payload = Encode.object [ ( "name", Encode.string name ) ]
+        }
+        (\result -> resumeFetchJson (Decode.nullable Decode.string) result)
+
+
 {-| Enqueue a background task to run after the response (fire-and-forget). The
 named handler lives in the Worker's task adapter; the request does not wait for
 it. Typically used from an `Action` via `Action.fromLoader`. -}
@@ -220,6 +250,65 @@ enqueue config =
         (\result -> resumeFetchJson (Decode.succeed ()) result)
 
 
+{-| Read the current session payload (whatever was last `setSession`-ed) and
+decode it. Returns `Nothing` when the session is empty.
+
+    type alias User = { id : String, email : String }
+
+    currentUser : Loader (Maybe User)
+    currentUser =
+        Loader.session userDecoder
+
+-}
+session : Decoder a -> Loader (Maybe a)
+session decoder =
+    Pending
+        { kind = "session", payload = Encode.object [] }
+        (\result -> resumeFetchJson (Decode.nullable decoder) result)
+
+
+{-| Read the current request's CSRF token. Embed it in form submissions
+(hidden input named `_csrf`) or in an `X-CSRF-Token` header on `fetch`. The
+TS-side `csrfMiddleware` checks the match on POST/PUT/PATCH/DELETE.
+-}
+csrfToken : Loader (Maybe String)
+csrfToken =
+    Pending
+        { kind = "csrfToken", payload = Encode.object [] }
+        (\result -> resumeFetchJson (Decode.nullable Decode.string) result)
+
+
+{-| Replace the current session payload. Typically used from an `Action` via
+`Action.fromLoader` after authenticating. The middleware persists and rolls
+the signed cookie on the response.
+
+    Action.fromLoader (Loader.setSession (encodeUser user))
+        |> Action.andThen (\_ -> Action.redirect "/dashboard")
+
+-}
+setSession : Encode.Value -> Loader ()
+setSession value =
+    Pending
+        { kind = "setSession"
+        , payload = Encode.object [ ( "value", value ) ]
+        }
+        (\_ -> Done ())
+
+
+{-| Destroy the current session. The middleware deletes the record from the
+store and clears the signed cookie on the response.
+
+    Action.fromLoader Loader.clearSession
+        |> Action.andThen (\_ -> Action.redirect "/")
+
+-}
+clearSession : Loader ()
+clearSession =
+    Pending
+        { kind = "clearSession", payload = Encode.object [] }
+        (\_ -> Done ())
+
+
 sqlPayload : String -> List Encode.Value -> Encode.Value
 sqlPayload sql params =
     Encode.object

package/elm-src/ElmSsr/Runtime.elm

@@ -117,7 +117,7 @@ advance : Config -> Loader (Document Never) -> ( State, Cmd Msg )
 advance config loader =
     case Loader.step loader of
         Loader.Resolved document ->
-            ( Rendered, render config document )
+            ( Rendered, render config [] document )
 
         Loader.Errored status message ->
             ( Aborted status message, renderError config status message )
@@ -128,36 +128,46 @@ advance config loader =
 
 advanceAction : Config -> Action (Document Never) -> ( State, Cmd Msg )
 advanceAction config action =
-    case Action.step action of
+    let
+        ( cookies, base ) =
+            Action.collectCookies action
+    in
+    case Action.step base of
         Action.Resolved document ->
-            ( Rendered, render config document )
+            ( Rendered, render config cookies document )
 
         Action.Errored status message ->
-            ( Aborted status message, renderError config status message )
+            ( Aborted status message, renderActionError config cookies status message )
 
         Action.Moved url ->
-            ( Rendered, config.ports.rendered (Action.encodeStep (always Json.null) (Action.Moved url)) )
+            ( Rendered, config.ports.rendered (Action.encodeStep cookies (always Json.null) (Action.Moved url)) )
 
         Action.SentJson value ->
-            ( Rendered, config.ports.rendered (Action.encodeStep (always Json.null) (Action.SentJson value)) )
+            ( Rendered, config.ports.rendered (Action.encodeStep cookies (always Json.null) (Action.SentJson value)) )
 
         Action.Await effect continue ->
             ( PerformingAction continue, config.ports.effectRequest (Loader.encodeEffect effect) )
 
 
-render : Config -> Document Never -> Cmd Msg
-render config document =
-    config.ports.rendered (Action.encodeStep Encode.encode (Action.Resolved (Document.map never document)))
+render : Config -> List Action.Cookie -> Document Never -> Cmd Msg
+render config cookies document =
+    config.ports.rendered (Action.encodeStep cookies Encode.encode (Action.Resolved (Document.map never document)))
 
 
 renderError : Config -> Int -> String -> Cmd Msg
 renderError config status message =
+    renderActionError config [] status message
+
+
+renderActionError : Config -> List Action.Cookie -> Int -> String -> Cmd Msg
+renderActionError config cookies status message =
     config.ports.rendered
         (Json.object
             [ ( "kind", Json.string "errored" )
             , ( "status", Json.int status )
             , ( "message", Json.string message )
             , ( "value", Encode.encode (Document.map never (Page.error status message)) )
+            , ( "cookies", Action.encodeCookies cookies )
             ]
         )