Create publishing identities

src/Email.gren

@@ -3,6 +3,7 @@ module Email exposing
     , fromString
     , toString
     , example
+    , example2
     )
 
 
@@ -39,3 +40,10 @@ toString (Email emailString) =
 example : Email
 example =
     Email "test@blackhole.postmarkapp.com"
+
+
+{-| Second example email used for testing.
+-}
+example2 : Email
+example2 =
+    Email "test2@blackhole.postmarkapp.com"

src/Main.gren

@@ -13,10 +13,12 @@ import Node exposing (Environment, Program)
 import Postmark
 import Registry.Db
 import Route.Error
+import Route.PublishingIdentity
 import Route.Session
 import Stream
 import Task exposing (Task)
 import Test.E2E.Helper as Helper
+import User exposing (User)
 
 
 main : Program Model Msg
@@ -170,11 +172,16 @@ update msg model =
 route : Model -> Request -> Response -> Task Never Response
 route model request response =
     let
+        path : Array String
         path =
             request.url.path
                 |> String.split "/"
                 |> Array.keepIf (\s -> s /= "")
 
+        config :
+            { secureContext : Maybe Crypto.SecureContext
+            , postmark : Maybe Postmark.Configuration
+            }
         config =
             { secureContext = model.secureContext
             , postmark = model.postmark
@@ -216,6 +223,17 @@ route model request response =
                         , response = response
                         }
 
+
+                -- PUBLISHING IDENTITY ROUTES
+
+
+                { method = POST, path = [ "publishing-identity" ] } ->
+                    Route.PublishingIdentity.create
+                        { db = model.db
+                        , body = request.body
+                        , response = response
+                        }
+
                 _ ->
                     Route.Error.notFound response
 

src/PublishingIdentity.gren

@@ -0,0 +1,110 @@
+module PublishingIdentity exposing
+    ( PublishingIdentity
+    , create
+    , get
+    )
+
+
+import Db
+import Db.Decode as Decode
+import Db.Encode as Encode
+import Task exposing (Task)
+import User exposing (User)
+
+
+type alias PublishingIdentity =
+    { id : Int
+    , userId : Int
+    , name : String
+    }
+
+
+create :
+    Db.Connection
+    -> { user : User, name : String }
+    -> Task Db.Error PublishingIdentity
+create db { user, name } =
+    let
+        insertIdentity =
+            Db.execute db
+                { statement =
+                    """
+                    INSERT INTO publishing_identity (name)
+                    VALUES (:name)
+                    """
+                , parameters =
+                    [ Encode.string "name" name
+                    ]
+                }
+
+        getIdentityId =
+            Db.getOne db
+                { query =
+                    """
+                    SELECT id FROM publishing_identity
+                    WHERE name = :name
+                    """
+                , parameters =
+                    [ Encode.string "name" name
+                    ]
+                , decoder = Decode.int "id"
+                }
+
+        insertUserLink identityId =
+            Db.execute db
+                { statement =
+                    """
+                    INSERT INTO publishing_identity_users (user_id, publishing_identity_id)
+                    VALUES (:user_id, :publishing_identity_id)
+                    """
+                , parameters =
+                    [ Encode.int "user_id" user.id
+                    , Encode.int "publishing_identity_id" identityId
+                    ]
+                }
+    in
+    insertIdentity
+        |> Task.andThen (\_ -> getIdentityId)
+        |> Task.andThen (\identityId ->
+            insertUserLink identityId
+                |> Task.map (\_ ->
+                    { id = identityId
+                    , userId = user.id
+                    , name = name
+                    }
+                )
+        )
+
+
+get :
+    Db.Connection
+    -> { userId : Int, name : String }
+    -> Task Db.Error PublishingIdentity
+get db { userId, name } =
+    Db.getOne db
+        { query =
+            """
+            SELECT pi.id, pi.name, piu.user_id
+            FROM publishing_identity pi
+            INNER JOIN publishing_identity_users piu
+                ON piu.publishing_identity_id = pi.id
+            WHERE piu.user_id = :user_id
+            AND pi.name = :name
+            """
+        , parameters =
+            [ Encode.int "user_id" userId
+            , Encode.string "name" name
+            ]
+        , decoder =
+            -- TODO: upgrade gren-ws4sql for the new api here
+            Decode.get3
+                (Decode.int "id")
+                (Decode.int "user_id")
+                (Decode.string "name")
+                (\id uid n ->
+                    { id = id
+                    , userId = uid
+                    , name = n
+                    }
+                )
+        }

src/Registry/Db.gren

@@ -65,7 +65,8 @@ migrate db =
             CREATE TABLE IF NOT EXISTS publishing_identity_users (
                 user_id INTEGER NOT NULL REFERENCES user(id),
                 publishing_identity_id INTEGER NOT NULL REFERENCES publishing_identity(id),
-                role TEXT
+                role TEXT,
+                UNIQUE(user_id, publishing_identity_id)
             ) STRICT
             """
           , parameters = []

src/Route/PublishingIdentity.gren

@@ -0,0 +1,81 @@
+module Route.PublishingIdentity exposing
+    ( create
+    )
+
+
+import Bytes exposing (Bytes)
+import Db
+import HttpServer.Response as Response exposing (Response)
+import Json.Decode
+import PublishingIdentity
+import Route.Error
+import Task exposing (Task)
+import User exposing (User)
+
+
+-- ENDPOINTS
+
+
+create :
+    { db : Db.Connection
+    , body : Bytes
+    , response : Response
+    }
+    -> Task Never Response
+create { db, body, response } =
+    when getCreateRequest body is
+        Nothing ->
+            Route.Error.invalidRequestData response
+                "Request json must contain a non-empty `session` and `name` field."
+
+        Just { sessionToken, name } ->
+            -- TODO: move user fetch to routing level
+            User.findBySessionToken db sessionToken
+                |> Task.andThen (\user ->
+                    PublishingIdentity.create db { user = user, name = name }
+                )
+                |> Task.map (\_ -> response)
+                |> Task.onError (\_ ->
+                    Route.Error.invalidRequestData response
+                        "Invalid session token."
+                )
+
+
+-- REQUEST PARSING
+
+
+type alias CreateRequest =
+    { sessionToken : String
+    , name : String
+    }
+
+
+getCreateRequest : Bytes -> Maybe CreateRequest
+getCreateRequest bytes =
+    bytes
+        |> Bytes.toString
+        |> Maybe.andThen decodeCreateRequest
+        |> Maybe.andThen validateCreateRequest
+
+
+decodeCreateRequest : String -> Maybe CreateRequest
+decodeCreateRequest json =
+    json
+        |> Json.Decode.decodeString createRequestDecoder
+        |> Result.toMaybe
+
+
+createRequestDecoder : Json.Decode.Decoder CreateRequest
+createRequestDecoder =
+    Json.Decode.map2
+        (\token name -> { sessionToken = token, name = name })
+        (Json.Decode.field "session" Json.Decode.string)
+        (Json.Decode.field "name" Json.Decode.string)
+
+
+validateCreateRequest : CreateRequest -> Maybe CreateRequest
+validateCreateRequest request =
+    if String.isEmpty request.sessionToken || String.isEmpty request.name then
+        Nothing
+    else
+        Just request

src/Test/E2E.gren

@@ -1,6 +1,7 @@
 module Test.E2E exposing (tests)
 
 import Crypto
+import Db
 import Dict
 import Expect
 import HttpClient
@@ -9,14 +10,17 @@ import Task
 import Test.Runner.Effectful exposing (Test, await, awaitError, concat, describe, test)
 import Test.E2E.Helper exposing (get, expectBadStatus, initDb)
 import Test.E2E.Route.Session
+import Test.E2E.Route.PublishingIdentity
 import Test.E2E.Postmark
+import Test.E2E.PublishingIdentity
 import Test.E2E.Session
 import Test.E2E.User
 
 
 tests : HttpClient.Permission -> Array Test
 tests httpPerm =
     let
+        db : Db.Connection
         db =
             initDb httpPerm
 
@@ -28,15 +32,23 @@ tests httpPerm =
     in
     [ await "Get secure context" Crypto.getSecureContext <| \secureContext ->
         concat
-            [ 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)
+
+            -- ROUTES
+
+            [ describe "Session route tests" (Test.E2E.Route.Session.tests db httpPerm secureContext)
+            , describe "PublishingIdentity route tests" (Test.E2E.Route.PublishingIdentity.tests db httpPerm secureContext)
             , describe "Home route tests"
                 -- There is no Home route yet
                 [ awaitError "GET /" (get httpPerm "/") <| \response ->
                     test "404s" <| \_ ->
                         expectBadStatus 404 response
                 ]
+
+            -- MODULES
+
+            , 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)
+            , describe "PublishingIdentity module tests" (Test.E2E.PublishingIdentity.tests db)
             ]
     ]

src/Test/E2E/PublishingIdentity.gren

@@ -0,0 +1,57 @@
+module Test.E2E.PublishingIdentity exposing (tests)
+
+
+import Db
+import Email
+import Expect
+import PublishingIdentity
+import Task exposing (Task)
+import Test.Runner.Effectful exposing (Test, await, awaitError, concat, describe, test)
+import User exposing (User)
+
+
+tests : Db.Connection -> Array Test
+tests db =
+    let
+        identityName =
+            "duplicate-name-test"
+
+        cleanPublishingIdentity : Task Db.Error Int
+        cleanPublishingIdentity =
+            Db.transaction db
+                [ { statement = "DELETE FROM publishing_identity_users", parameters = [] }
+                , { statement = "DELETE FROM publishing_identity", parameters = [] }
+                ]
+                |> Task.map (\_ -> 0)
+    in
+    [ describe "PublishingIdentity.create"
+        [ await "clean publishing identity tables" cleanPublishingIdentity <| \_ ->
+          await "create user 1" (User.findOrCreate db Email.example) <| \user1 ->
+          await "create user 2" (User.findOrCreate db Email.example2) <| \user2 ->
+          await "create identity for user 1" (PublishingIdentity.create db { user = user1, name = identityName }) <| \_ ->
+            concat
+                [ awaitError "create identity with same name and same user"
+                    (PublishingIdentity.create db { user = user1, name = identityName }) <| \error ->
+                        test "fails when name already exists for same user" <| \_ ->
+                            expectUniqueConstraintError error
+
+                , awaitError "create identity with same name and different user"
+                    (PublishingIdentity.create db { user = user2, name = identityName }) <| \error ->
+                        test "fails when name already exists for different user" <| \_ ->
+                            expectUniqueConstraintError error
+                ]
+        ]
+    ]
+
+
+expectUniqueConstraintError : Db.Error -> Expect.Expectation
+expectUniqueConstraintError error =
+    when error is
+        Db.Error message ->
+            if String.contains "unique" (String.toLower message) then
+                Expect.pass
+            else
+                Expect.fail ("Expected unique constraint error, got: " ++ message)
+
+        _ ->
+            Expect.fail ("Expected Db.Error with unique constraint message, got: " ++ Db.errorToString error)