diff --git a/devbox.json b/devbox.json index a5c046b..7b5b001 100644 --- a/devbox.json +++ b/devbox.json @@ -5,7 +5,8 @@ "gren@0.6.3", "curl@latest", "jq@latest", - "github:blaix/ws4sql-nix/0.17dev7" + "github:blaix/ws4sql-nix/0.17dev7", + "sqlite@latest" ], "shell": { "init_hook": [], @@ -15,6 +16,9 @@ ], "create-session": [ "./scripts/create-session.sh \"$@\"" + ], + "fetch-session": [ + "./scripts/fetch-session.sh \"$@\"" ] } } diff --git a/devbox.lock b/devbox.lock index 67327ba..ed46df5 100644 --- a/devbox.lock +++ b/devbox.lock @@ -360,6 +360,130 @@ "store_path": "/nix/store/1bmfcixbhs5fxv2zzyc45grx3xgc90j9-nodejs-20.18.3" } } + }, + "sqlite@latest": { + "last_modified": "2026-03-15T17:58:12Z", + "resolved": "github:NixOS/nixpkgs/a07d4ce6bee67d7c838a8a5796e75dff9caa21ef#sqlite", + "source": "devbox-search", + "version": "3.51.2", + "systems": { + "aarch64-darwin": { + "outputs": [ + { + "name": "bin", + "path": "/nix/store/h7mm7vizdfzx9dkz8yvq1h3z1dkvk68k-sqlite-3.51.2-bin", + "default": true + }, + { + "name": "man", + "path": "/nix/store/3rr70fkzzwyvizkjbghbpfyy0xnpk7c8-sqlite-3.51.2-man", + "default": true + }, + { + "name": "dev", + "path": "/nix/store/g3pqc7h5cyvq69xi1ci4s73cn3h5rx93-sqlite-3.51.2-dev" + }, + { + "name": "doc", + "path": "/nix/store/wkgrqxrqkn7pg26g9r02amdbhgqqa596-sqlite-3.51.2-doc" + }, + { + "name": "out", + "path": "/nix/store/n78wl37nhy4qfspmkl37ib43fl9mgzkl-sqlite-3.51.2" + } + ], + "store_path": "/nix/store/h7mm7vizdfzx9dkz8yvq1h3z1dkvk68k-sqlite-3.51.2-bin" + }, + "aarch64-linux": { + "outputs": [ + { + "name": "bin", + "path": "/nix/store/8nlaycnvd4dc6q7vdh9nmda5rfw2wq1l-sqlite-3.51.2-bin", + "default": true + }, + { + "name": "man", + "path": "/nix/store/q391c8xkvjy9q7qr2h18f6hci3gsyfmy-sqlite-3.51.2-man", + "default": true + }, + { + "name": "out", + "path": "/nix/store/0abc9j54cpa41gmdcibp2hcyycd4w2dx-sqlite-3.51.2" + }, + { + "name": "debug", + "path": "/nix/store/wr8dr1fpnv9qb4n3hvl8h56yf613605w-sqlite-3.51.2-debug" + }, + { + "name": "dev", + "path": "/nix/store/hxcb0bf92dz5xm5i9ksb54m78d9mnbkv-sqlite-3.51.2-dev" + }, + { + "name": "doc", + "path": "/nix/store/66hhhlpis6bxgvjq2bnd7m97qryzmpjd-sqlite-3.51.2-doc" + } + ], + "store_path": "/nix/store/8nlaycnvd4dc6q7vdh9nmda5rfw2wq1l-sqlite-3.51.2-bin" + }, + "x86_64-darwin": { + "outputs": [ + { + "name": "bin", + "path": "/nix/store/3n7rwbzrqg3v9x1zkcyca2p7vqn6006k-sqlite-3.51.2-bin", + "default": true + }, + { + "name": "man", + "path": "/nix/store/6n9alxra4pk4gcvirric8676p0nvajgx-sqlite-3.51.2-man", + "default": true + }, + { + "name": "doc", + "path": "/nix/store/s7dhcwp8c67s3711g3cavn8pcm7q6d0d-sqlite-3.51.2-doc" + }, + { + "name": "out", + "path": "/nix/store/vr5ff6vjdy7z2g7zsnr2fhd83fdb22j6-sqlite-3.51.2" + }, + { + "name": "dev", + "path": "/nix/store/vwzw5yj8z88sza9sczg9ra8lfx6zqv1f-sqlite-3.51.2-dev" + } + ], + "store_path": "/nix/store/3n7rwbzrqg3v9x1zkcyca2p7vqn6006k-sqlite-3.51.2-bin" + }, + "x86_64-linux": { + "outputs": [ + { + "name": "bin", + "path": "/nix/store/k87a0gv4hg1zmm8j5d3ffmxyvhr13i41-sqlite-3.51.2-bin", + "default": true + }, + { + "name": "man", + "path": "/nix/store/msdk5dj7zsrxyzdfirfdj2pgff5s2qbn-sqlite-3.51.2-man", + "default": true + }, + { + "name": "out", + "path": "/nix/store/whs07fdxlw22fi8b3jzd2z871dh41qx6-sqlite-3.51.2" + }, + { + "name": "debug", + "path": "/nix/store/npq7nfarcsgqd0ks8x0crlksiy5lvvfn-sqlite-3.51.2-debug" + }, + { + "name": "dev", + "path": "/nix/store/5j4mx4vckmmms2spy8x8kqjxcb12kpf5-sqlite-3.51.2-dev" + }, + { + "name": "doc", + "path": "/nix/store/ggx362g7cci0gjlyd3kc39gcbkwrzvkz-sqlite-3.51.2-doc" + } + ], + "store_path": "/nix/store/k87a0gv4hg1zmm8j5d3ffmxyvhr13i41-sqlite-3.51.2-bin" + } + } } } } diff --git a/scripts/fetch-session.sh b/scripts/fetch-session.sh new file mode 100755 index 0000000..b1c0366 --- /dev/null +++ b/scripts/fetch-session.sh @@ -0,0 +1,33 @@ +#!/usr/bin/env bash + +set -euo pipefail + +usage() { + echo "Usage: $(basename "$0") FETCH_SESSION_TOKEN EMAIL_CONFIRMATION_CODE [HOST]" + echo + echo "Fetch a session token by POSTing a fetchSessionToken and emailConfirmationCode" + echo "to the /session/fetch endpoint." + echo + echo "Arguments:" + echo " FETCH_SESSION_TOKEN The fetch session token (required)" + echo " EMAIL_CONFIRMATION_CODE The email confirmation code (required)" + echo " HOST Server host (default: localhost:3000)" + echo + echo "Examples:" + echo " $(basename "$0") abc-123 ABCD1234" + echo " $(basename "$0") abc-123 ABCD1234 registry.gren-lang.org" +} + +if [ $# -lt 2 ] || [ "$1" = "-h" ] || [ "$1" = "--help" ]; then + usage + [ "$#" -lt 2 ] && exit 1 + exit 0 +fi + +FETCH_SESSION_TOKEN="$1" +EMAIL_CONFIRMATION_CODE="$2" +HOST="${3:-localhost:3000}" + +curl -sS -w "\nHTTP Status: %{http_code}\n" -o >(jq .) -X POST "http://${HOST}/session/fetch" \ + -H "Content-Type: application/json" \ + -d "{\"fetchSessionToken\": \"${FETCH_SESSION_TOKEN}\", \"emailConfirmationCode\": \"${EMAIL_CONFIRMATION_CODE}\"}" diff --git a/src/Main.gren b/src/Main.gren index 1a0bfa6..8aee0f5 100644 --- a/src/Main.gren +++ b/src/Main.gren @@ -4,13 +4,11 @@ import Bytes exposing (Bytes) import Crypto import Db import Dict -import Email exposing (Email) import Db.Encode import HttpClient import HttpServer exposing (Request, ServerError(..), Method(..)) import HttpServer.Response as Response exposing (Response) import Init -import Json.Decode import Node exposing (Environment, Program) import Postmark import Registry.Db @@ -183,6 +181,11 @@ route model request response = } in when config is + + + -- CHECK SERVER PRE-REQS + + { secureContext = Nothing } -> Route.Error.serverError response "Missing secure context." @@ -192,44 +195,31 @@ route model request response = { postmark = Just postmark, secureContext = Just secureContext } -> when { method = request.method, path = path } is + + -- SESSION ROUTES + + { method = POST, path = [ "session" ] } -> - when getEmail request.body is - Just email -> - Route.Session.create - { db = model.db - , postmark = postmark - , secureContext = secureContext - , requestData = { email = email } - , response = response - } - - Nothing -> - Route.Error.invalidRequestData response - "Request json did not contain a valid `email` field." + Route.Session.create + { db = model.db + , postmark = postmark + , secureContext = secureContext + , body = request.body + , response = response + } + + { method = POST, path = [ "session", "fetch" ] } -> + Route.Session.fetch + { db = model.db + , secureContext = secureContext + , body = request.body + , response = response + } _ -> Route.Error.notFound response -getEmail : Bytes -> Maybe Email -getEmail bytes = - bytes - |> Bytes.toString - |> Maybe.andThen decodeEmail - |> Maybe.andThen Email.fromString - - -decodeEmail : String -> Maybe String -decodeEmail json = - json - |> Json.Decode.decodeString emailDecoder - |> Result.toMaybe - - -emailDecoder : Json.Decode.Decoder String -emailDecoder = - Json.Decode.field "email" Json.Decode.string - print : Stream.Writable Bytes -> String -> Task Never {} print stream string = diff --git a/src/Registry/Db.gren b/src/Registry/Db.gren index 53a94a1..36e5eee 100644 --- a/src/Registry/Db.gren +++ b/src/Registry/Db.gren @@ -44,7 +44,7 @@ migrate db = fetch_session_token TEXT NOT NULL UNIQUE, -- Create and return this when CLI posts with email_confirmation_code and fetch_session_token - session_token TEXT UNIQUE + token TEXT UNIQUE ) STRICT """ , parameters = [] diff --git a/src/Route/Session.gren b/src/Route/Session.gren index 0b4370b..2a7858a 100644 --- a/src/Route/Session.gren +++ b/src/Route/Session.gren @@ -1,5 +1,6 @@ module Route.Session exposing ( create + , fetch ) @@ -11,6 +12,7 @@ import HttpClient import HttpServer exposing (Request) import HttpServer.Response as Response exposing (Response) import Postmark +import Route.Error import Json.Decode import Json.Encode import Session exposing (Session) @@ -26,20 +28,112 @@ type Error -- ENDPOINTS -create : +{-| POST email to create a session. + +This will email a confirmation code and return a fetch session token. +Both must be POSTED to `fetch` to get a long lived session token. +-} +create : { db : Db.Connection , postmark : Postmark.Configuration , secureContext : Crypto.SecureContext - , requestData : { email : Email } + , body : Bytes + , response : Response + } + -> Task Never Response +create { db, secureContext, postmark, body, response } = + when getEmail body is + Nothing -> + Route.Error.invalidRequestData response + "Request json did not contain a valid `email` field." + + Just email -> + findOrCreateUser db email + |> Task.andThen (createSession db secureContext) + |> Task.andThen (sendEmailConfirmationCode postmark) + |> Task.map (createSuccess response) + |> Task.onError (createFailed response) + + +{-| Fetch your long-lived session token. + +POST emailConfirmationCode and fetchSessionToken from the `create` call to get +a long-lived session token you can store to make authenticated API requests. +-} +fetch : + { db : Db.Connection + , secureContext : Crypto.SecureContext + , body : Bytes , response : Response } -> Task Never Response -create { db, secureContext, postmark, requestData, response } = - findOrCreateUser db requestData.email - |> Task.andThen (createSession db secureContext ) - |> Task.andThen (sendEmailConfirmationCode postmark) - |> Task.map (createSuccess response) - |> Task.onError (createFailed response) +fetch { db, secureContext, body, response } = + when getFetchRequest body is + Nothing -> + Route.Error.invalidRequestData response + "Request json invalid." + + Just { fetchSessionToken, emailConfirmationCode } -> + Session.fetch + { db = db + , secureContext = secureContext + , fetchSessionToken = fetchSessionToken + , emailConfirmationCode = emailConfirmationCode + } + |> Task.mapError DbError + |> Task.map (fetchSuccess response) + |> Task.onError (fetchFailed response) + + +-- REQUEST PARSING + + +getEmail : Bytes -> Maybe Email +getEmail bytes = + bytes + |> Bytes.toString + |> Maybe.andThen decodeEmail + |> Maybe.andThen Email.fromString + + +decodeEmail : String -> Maybe String +decodeEmail json = + json + |> Json.Decode.decodeString emailDecoder + |> Result.toMaybe + + +emailDecoder : Json.Decode.Decoder String +emailDecoder = + Json.Decode.field "email" Json.Decode.string + + +type alias FetchRequest = + { fetchSessionToken : String + , emailConfirmationCode : String + } + + +getFetchRequest : Bytes -> Maybe FetchRequest +getFetchRequest bytes = + bytes + |> Bytes.toString + |> Maybe.andThen decodeFetchRequest + + +decodeFetchRequest : String -> Maybe FetchRequest +decodeFetchRequest json = + json + |> Json.Decode.decodeString fetchRequestDecoder + |> Result.toMaybe + + +fetchRequestDecoder : Json.Decode.Decoder FetchRequest +fetchRequestDecoder = + Json.Decode.map2 + (\token code -> { fetchSessionToken = token, emailConfirmationCode = code }) + (Json.Decode.field "fetchSessionToken" Json.Decode.string) + (Json.Decode.field "emailConfirmationCode" Json.Decode.string) -- ACTIONS @@ -106,6 +200,45 @@ createFailed response error = |> Task.succeed +fetchSuccess : Response -> String -> Response +fetchSuccess response sessionToken = + let + responseJson = + Json.Encode.object + [ { key = "sessionToken" + , value = Json.Encode.string sessionToken + } + ] + in + response + |> Response.setHeader "Content-Type" "application/json" + |> Response.setBody (Json.Encode.encode 0 responseJson) + + +fetchFailed : Response -> Error -> Task x Response +fetchFailed response error = + when error is + DbError Db.NoResultError -> + response + |> Response.setStatus 400 + |> setErrorMessage "Invalid token or confirmation code" + |> Task.succeed + + DbError _ -> + response + -- TODO: server error logging + |> Response.setStatus 500 + |> setErrorMessage "Unexpected DB error" + |> Task.succeed + + SendEmailFailed _ -> + response + -- TODO: server error logging + |> Response.setStatus 500 + |> setErrorMessage "Unexpected error" + |> Task.succeed + + -- HELPERS diff --git a/src/Session.gren b/src/Session.gren index e5ba635..543f821 100644 --- a/src/Session.gren +++ b/src/Session.gren @@ -1,6 +1,7 @@ module Session exposing ( Session , create + , fetch ) @@ -16,11 +17,17 @@ import Time import User exposing (User) +{-| Create a Session. + +It will not have a usable token until you call `fetch` with a valid +fetchSessionToken and emailConfirmationCode. +-} type alias Session = { created : Time.Posix , user : User , emailConfirmationCode : String , fetchSessionToken : String + , token: Maybe String } @@ -39,6 +46,7 @@ create { db, user, secureContext } = , user = user , emailConfirmationCode = code , fetchSessionToken = uuid2 + , token = Nothing } @@ -60,6 +68,66 @@ generateEmailConfirmationCode secureContext = ) +{-| Fetch the long-lived session token. + +You must pass the fetchSessionToken and emailConfirmationCode from the `create` +step. Creates and returns the long-lived session token. To keep +fetchSessionToken single-use, this will error if session token already exists. +-} +fetch : + { db : Db.Connection + , secureContext : Crypto.SecureContext + , fetchSessionToken : String + , emailConfirmationCode : String + } + -> Task Db.Error String +fetch { db, secureContext, fetchSessionToken, emailConfirmationCode } = + let + getSession cutoff = + Db.getOne db + { query = + """ + select id from session + where fetch_session_token = :fetch_session_token + and email_confirmation_code = :email_confirmation_code + and created > :cutoff + and token is null + """ + , parameters = + [ Db.Encode.string "fetch_session_token" fetchSessionToken + , Db.Encode.string "email_confirmation_code" emailConfirmationCode + , Db.Encode.posix "cutoff" cutoff + ] + , decoder = + Db.Decode.int "id" + } + + setSessionToken id sessionToken = + Db.execute db + { statement = + """ + update session + set token = :token + where id = :id + """ + , parameters = + [ Db.Encode.string "token" sessionToken + , Db.Encode.int "id" id + ] + } + in + Task.await Time.now <| \now -> + let + fifteenMinutesAgo = + (Time.posixToMillis now) - (15 * 60 * 1000) + |> Time.millisToPosix + in + Task.await (getSession fifteenMinutesAgo) <| \sessionId -> + Task.await (Crypto.randomUuidV4 secureContext) <| \sessionToken -> + Task.await (setSessionToken sessionId sessionToken) <| \_ -> + Task.succeed sessionToken + + -- DB HELPERS diff --git a/src/Test/E2E.gren b/src/Test/E2E.gren index ba91c96..ff876c4 100644 --- a/src/Test/E2E.gren +++ b/src/Test/E2E.gren @@ -28,7 +28,7 @@ tests httpPerm = in [ await "Get secure context" Crypto.getSecureContext <| \secureContext -> concat - [ describe "Session route tests" (Test.E2E.Route.Session.tests httpPerm) + [ describe "Session route tests" (Test.E2E.Route.Session.tests httpPerm secureContext) , describe "Session module tests" (Test.E2E.Session.tests db secureContext) , describe "User module tests" (Test.E2E.User.tests db) , describe "Postmark module tests" (Test.E2E.Postmark.tests postmark) diff --git a/src/Test/E2E/Helper.gren b/src/Test/E2E/Helper.gren index 8959ac8..68f8819 100644 --- a/src/Test/E2E/Helper.gren +++ b/src/Test/E2E/Helper.gren @@ -1,5 +1,7 @@ module Test.E2E.Helper exposing - ( expectBadStatus + ( createSession + , expireFetchToken + , expectBadStatus , expectJson , initDb , get @@ -9,13 +11,17 @@ module Test.E2E.Helper exposing import Bytes exposing (Bytes) +import Crypto import Db +import Db.Encode import Email import Expect exposing (Expectation) import HttpClient exposing (Response) import Json.Decode import Json.Encode +import Session exposing (Session) import Task exposing (Task) +import Time import User @@ -79,3 +85,39 @@ expectJson decoder expected bytes = Err error -> Expect.fail (Json.Decode.errorToString error) + + +createSession : Db.Connection -> Crypto.SecureContext -> Task Db.Error Session +createSession db secureContext = + User.findOrCreate db Email.example + |> Task.andThen + (\user -> + Session.create + { db = db + , user = user + , secureContext = secureContext + } + ) + + +expireFetchToken : Db.Connection -> Session -> Task Db.Error {} +expireFetchToken db session = + Task.await Time.now <| \now -> + let + sixteenMinutesAgo = + (Time.posixToMillis now) - (16 * 60 * 1000) + |> Time.millisToPosix + in + Db.execute db + { statement = + """ + update session + set created = :created + where fetch_session_token = :fetch_session_token + """ + , parameters = + [ Db.Encode.posix "created" sixteenMinutesAgo + , Db.Encode.string "fetch_session_token" session.fetchSessionToken + ] + } + |> Task.map (\_ -> {}) diff --git a/src/Test/E2E/Route/Session.gren b/src/Test/E2E/Route/Session.gren index 0adf6a0..4941c8e 100644 --- a/src/Test/E2E/Route/Session.gren +++ b/src/Test/E2E/Route/Session.gren @@ -2,6 +2,7 @@ module Test.E2E.Route.Session exposing (tests) import Bytes +import Crypto import Db import Db.Encode import Db.Decode @@ -11,22 +12,31 @@ import HttpClient import Json.Decode import Json.Encode import Task exposing (Task) -import Test.Runner.Effectful exposing (Test, await, awaitError, concat, describe, test) -import Test.E2E.Helper exposing (initDb, get, post, postWithJson, expectBadStatus, expectJson) +import Test.Runner.Effectful exposing (Test, await, awaitError, concat, describe, test, todo) +import Test.E2E.Helper exposing (expireFetchToken, createSession, initDb, get, post, postWithJson, expectBadStatus, expectJson) import User exposing (User) -tests : HttpClient.Permission -> Array Test -tests httpPerm = +tests : HttpClient.Permission -> Crypto.SecureContext -> Array Test +tests httpPerm secureContext = let db : Db.Connection db = initDb httpPerm in + + + -- GET /session (404) + + [ awaitError "GET /session" (get httpPerm "/session") <| \response -> test "404s" <| \_ -> expectBadStatus 404 response + + -- POST /session (create) + + , describe "Create session" <| let goodEmail = @@ -83,4 +93,77 @@ tests httpPerm = ) ] ] + + + -- POST /session/fetch (get session token) + + + , await "Create test session" (createSession db secureContext) <| \session -> + describe "Fetch session token" <| + let + doPost { token, code } = + postWithJson httpPerm "/session/fetch" <| + Json.Encode.object + [ { key = "fetchSessionToken" + , value = Json.Encode.string token + } + , { key = "emailConfirmationCode" + , value = Json.Encode.string code + } + ] + in + [ awaitError "with bad token and code" + (doPost { token = "", code = "" }) <| \response -> + test "Responds with 400 error" <| \_ -> + expectBadStatus 400 response + + , awaitError "with good token and bad code" + (doPost { token = session.fetchSessionToken, code = "" }) <| \response -> + test "Responds with 400 error" <| \_ -> + expectBadStatus 400 response + + , awaitError "with bad token and good code" + (doPost { token = "", code = session.emailConfirmationCode }) <| \response -> + test "Responds with 400 error" <| \_ -> + expectBadStatus 400 response + + , await "with good token and good code" + (doPost { token = session.fetchSessionToken, code = session.emailConfirmationCode }) <| \response -> + concat + [ test "Responds successfully" <| \_ -> + Expect.equal 200 response.statusCode + + , await "Getting session token from db" + (Db.getOne db + { query = + """ + select token from session + where fetch_session_token = :fetch_session_token + """ + , parameters = + [ Db.Encode.string "fetch_session_token" session.fetchSessionToken ] + , decoder = + Db.Decode.string "token" + } + ) + (\expectedToken -> + test "responds with session token" <| \_ -> + response.data + |> expectJson + (Json.Decode.field "sessionToken" Json.Decode.string) + expectedToken + ) + + , awaitError "Trying to fetch it again" + (doPost { token = session.fetchSessionToken, code = session.emailConfirmationCode }) <| \secondResponse -> + test "Responds with a 400 error" <| \_ -> + expectBadStatus 400 secondResponse + ] + + , await "force token to expire" (expireFetchToken db session) <| \_ -> + awaitError "with expired token" + (doPost { token = session.fetchSessionToken, code = session.emailConfirmationCode }) <| \response -> + test "Responds with 400 error" <| \_ -> + expectBadStatus 400 response + ] ]