Improved handling metadata links (#9)

* Added link titles

* Preserve metadata ordering

* Added dev run commands to Makefile

* Added explanation to the development guide

* Made caddy 2 the only config since we probably don't want to maintain two versions.

* Use `id` instead of `ord`

* Added ghcid version of Caddyfile

* Renamed staging to deployment

.gitignore

@@ -7,3 +7,4 @@ dist-newstyle
 octopod-config.json
 frontend-result
 octopod-css/node_modules
+dev/certs/*

Caddyfile

@@ -1 +0,0 @@
-Caddyfile2

Caddyfile

@@ -0,0 +1,27 @@
+http://localhost:8000
+
+
+file_server
+
+rewrite /api/* {path}
+reverse_proxy /api/* localhost:3002
+
+@production {
+  path_regexp production /static/(.*)
+}
+rewrite @production /octopod-css/production/{http.regexp.production.1}
+
+rewrite /config.json /dev/config.json
+rewrite * /frontend-result/bin/frontend.jsexe/{path}
+
+
+@3003 {
+  not path /octopod-css/* /frontend-result/* /dev/config.json
+}
+
+reverse_proxy @3003 localhost:3003
+
+log {
+	output stdout
+	format single_field common_log
+}

Caddyfile1

@@ -1,42 +0,0 @@
-localhost:8000
-
-mime .css text/css
-
-rewrite /static/styles {
-  r (.*)
-  to /octopod-css/production/styles/{1}
-}
-
-mime .js 	application/javascript
-
-rewrite /static/vendors {
-  r (.*)
-  to /octopod-css/production/vendors/{1}
-}
-
-rewrite /static/scripts {
-  r (.*)
-  to /octopod-css/production/scripts/{1}
-}
-
-rewrite /static/images {
-  r (.*)
-  to /octopod-css/production/images/{1}
-}
-
-proxy /api localhost:3002 {
-  transparent
-}
-
-mime .json 	application/json
-rewrite /config.json /octopod-config.json
-
-rewrite /ghcjs /frontend-result/bin/frontend.jsexe/index.html
-
-proxy / localhost:3003 {
-  transparent
-  websocket
-  except /octopod-css/ /frontend-result/ /octopod-config.json
-}
-
-log / stdout

CaddyfileGhcid

@@ -3,20 +3,18 @@ http://localhost:8000
 
 file_server
 
+rewrite /api/* {path}
+reverse_proxy /api/* localhost:3002
+
 @production {
   path_regexp production /static/(.*)
 }
-
 rewrite @production /octopod-css/production/{http.regexp.production.1}
 
-reverse_proxy /api localhost:3002
-
-rewrite /config.json /octopod-config.json
-
-rewrite /ghcjs /frontend-result/bin/frontend.jsexe/index.html
+rewrite /config.json /dev/config.json
 
 @3003 {
-  not path /octopod-css/* /frontend-result/* /octopod-config.json
+  not path /octopod-css/* /frontend-result/* /dev/config.json
 }
 
 reverse_proxy @3003 localhost:3003

Development_guide.md

@@ -64,9 +64,36 @@ For development, we have set up `ghcid` commands that rebuild the project every
 - `ghcid-cli`
 - `ghcid-frontend`
 
-### Frontend proxy
+### Running the project locally
 
-The frontend should be accessed through a proxy. We have set up [caddy](https://caddyserver.com) configs to ease development. You will need place an `octopod-config.json` file at the root of the repository containing a [config](../../charts/octopod/templates/octopod-nginx-configmap.yaml#L15-L20). `app_auth` can be an arbitrary string – it will not affect anything when running locally.
+We have two commands to run the backend and frontend in the `Makefile`:
+
+- `run-backend-dev`
+
+   Builds a production version of the backend server, runs database migrations and starts the server with mock control scripts. You can see the used config in [`dev/dev_backend.sh`](./dev/dev_backend.sh).
+
+   ### NOTE:
+
+   1. You need to have a [Postgres](https://www.postgresql.org) database running on `localhost:5432` (the default port).
+
+   2. You need to create an empty `octopod` database.
+
+   3. You also need to have an `octopod:octopod` user set up as it will be used by the server to access the database.
+
+      The easiest way to do this is by running the following command after you have _Postgres running_:
+      ```bash
+      psql -c "CREATE ROLE IF NOT EXISTS octopod WITH PASSWORD 'octopod' SUPERUSER LOGIN;"
+      ```
+
+   4. You will need [sqitch](https://sqitch.org) installed on your system as it will be used to run migrations on the database.
+
+- `run-frontend-dev`
+
+   Build a production version of the frontend and runs it locally, pointing it to the locally running backend server.
+
+   ### NOTE:
+
+   You need to have [_Caddy 2_](https://caddyserver.com/v2) installed on your system as it is automatically used as a proxy.
 
 ### Stack
 

Makefile

@@ -1,4 +1,4 @@
-.PHONY: build-backend build-octo-cli build-frontend docs backend-docs frontend-docs repl shell shell-ghcjs ghcid ghcid-cli ghcid-frontend push-octopod
+.PHONY: build-backend build-octo-cli build-frontend docs backend-docs frontend-docs repl shell shell-ghcjs ghcid ghcid-cli ghcid-frontend push-octopod run-backend-dev run-frontend-dev
 
 build-backend:
 	nix-build . -A ghc.octopod-backend
@@ -37,3 +37,18 @@ ghcid-frontend:
 
 push-octopod:
 	./build.sh build-and-push latest
+
+run-backend-dev: dev/certs/server_cert.pem dev/certs/server_key.pem
+	./dev/dev_backend.sh `nix-build . -A ghc.octopod-backend`
+
+run-frontend-dev: build-frontend
+	caddy run
+
+dev/certs/server_cert.pem dev/certs/server_key.pem:
+	openssl req -x509 -newkey rsa:4096 -keyout dev/certs/server_key.pem -out dev/certs/server_cert.pem -nodes -subj "/CN=localhost/O=Server"
+
+dev/certs/client_csr.pem dev/certs/client_key.pem:
+	openssl req -newkey rsa:4096 -keyout dev/certs/client_key.pem -out dev/certs/client_csr.pem -nodes -subj "/CN=Client"
+
+dev/certs/client_cert.pem: dev/certs/client_csr.pem dev/certs/server_cert.pem dev/certs/server_key.pem
+	openssl x509 -req -in dev/certs/client_csr.pem -CA dev/certs/server_cert.pem -CAkey dev/certs/server_key.pem -out dev/certs/client_cert.pem -set_serial 01 -days 3650)

dev/config.json

@@ -0,0 +1,5 @@
+{
+  "app_url": "http://localhost:8000",
+  "ws_url": "ws://localhost:4020",
+  "app_auth": ""
+}

dev/dev_backend.sh

@@ -0,0 +1,29 @@
+#!/bin/bash
+
+(cd migrations && sqitch deploy -t postgresql://octopod:octopod@localhost:5432/octopod)
+
+export MOUNT_DIR=./dev
+
+export PROJECT_NAME="Example Project"
+export BASE_DOMAIN=octopod.example.com
+export NAMESPACE=deployment
+export ARCHIVE_RETENTION=60
+export STATUS_UPDATE_TIMEOUT=600
+export CREATION_COMMAND=$MOUNT_DIR/echo.sh
+export UPDATE_COMMAND=$MOUNT_DIR/echo.sh
+export UPDATE_ENVS_COMMAND=$MOUNT_DIR/echo.sh
+export ARCHIVE_COMMAND=$MOUNT_DIR/echo.sh
+export CHECKING_COMMAND=$MOUNT_DIR/echo.sh
+export CLEANUP_COMMAND=$MOUNT_DIR/echo.sh
+export ARCHIVE_CHECKING_COMMAND=$MOUNT_DIR/echo.sh
+export TAG_CHECKING_COMMAND=$MOUNT_DIR/echo.sh
+export INFO_COMMAND=$MOUNT_DIR/info.sh
+$1/bin/octopod-exe \
+    --port 4443 \
+    --ui-port 3002 \
+    --ws-port 4020 \
+    --db "host='127.0.0.1' port=5432 user='octopod' password='octopod'" \
+    --db-pool-size 10 \
+    --tls-cert-path dev/certs/server_cert.pem \
+    --tls-key-path dev/certs/server_key.pem \
+    --tls-store-path /tmp/tls_store

dev/echo.sh

@@ -0,0 +1,4 @@
+#!/bin/bash
+
+echo $0 $@
+exit 0

dev/info.sh

@@ -0,0 +1,6 @@
+#!/bin/bash
+
+echo "key,value"
+echo "key2,value2"
+
+exit 0

octopod-backend/src/Octopod/Server.hs

@@ -41,6 +41,7 @@ import           System.Process.Typed
 
 import           Common.Utils
 import           Common.Validation (isNameValid)
+import           Database.PostgreSQL.Simple.Transaction
 import           Octopod.API
 import           Octopod.PowerAPI
 import           Octopod.Server.Args
@@ -385,8 +386,7 @@ updateDeploymentInfo dName st = do
     case ec of
       ExitSuccess -> do
         dMeta <- parseDeploymentMetadata (lines . unStdout $ out)
-        forM_ dMeta $ \meta ->
-          upsertDeploymentMetadata (pool st) dName meta
+        upsertDeploymentMetadata (pool st) dName dMeta
       ExitFailure _ ->
         log $
           "could not get deployment info, exit code: " <> (pack . show $ ec)
@@ -1045,7 +1045,8 @@ selectDeploymentMetadata conn dName = do
   let
     q =
       "SELECT key, value FROM deployment_metadata \
-      \WHERE deployment_id = (SELECT id FROM deployments WHERE name = ?)"
+      \WHERE deployment_id = (SELECT id FROM deployments WHERE name = ?) \
+      \ORDER BY id ASC"
   rows <- query conn q (Only dName)
   for rows $ \(k, v) -> pure $ DeploymentMetadata k v
 
@@ -1065,21 +1066,23 @@ deleteDeploymentMetadata pgPool dName = do
 upsertDeploymentMetadata
   :: PgPool
   -> DeploymentName
-  -> DeploymentMetadata
+  -> [DeploymentMetadata]
   -> IO ()
-upsertDeploymentMetadata pgPool dName dMetadata = do
+upsertDeploymentMetadata pgPool dName dMetadatas = do
   let
-    q     =
-      "INSERT INTO deployment_metadata \
-      \(deployment_id, key, value, created_at, updated_at) \
-      \(SELECT id, ?, ?, now(), now() FROM deployments WHERE name = ?) \
-      \ON CONFLICT (deployment_id, key) \
-      \DO \
-        \UPDATE SET key = ?, value = ?, updated_at = now()"
-    key   = deploymentMetadataKey dMetadata
-    value = deploymentMetadataValue dMetadata
-  void $ withResource pgPool $ \conn ->
-    execute conn q (key, value, dName, key, value)
+  withResource pgPool $ \conn -> withTransactionSerializable conn $ do
+    void $ execute
+      conn
+      "DELETE FROM deployment_metadata \
+      \WHERE deployment_id = (SELECT id FROM deployments WHERE name = ?)"
+      (Only dName)
+    forM_ dMetadatas $ \dMeta ->
+      execute
+        conn
+        "INSERT INTO deployment_metadata \
+        \(deployment_id, key, value, created_at, updated_at) \
+        \(SELECT id, ?, ?, now(), now() FROM deployments WHERE name = ?)"
+        (deploymentMetadataKey dMeta, deploymentMetadataValue dMeta, dName)
 
 -- | Checks the existence of a deployment tag.
 -- Returns 404 'Tag not found' response if the deployment tag doesn't exist.

octopod-common/src/Common/Types.hs

@@ -117,8 +117,8 @@ data DeploymentLog = DeploymentLog
   deriving (FromJSON, ToJSON) via Snake DeploymentLog
 
 data DeploymentMetadata = DeploymentMetadata
-  { deploymentMetadataKey :: Text
-  , deploymentMetadataValue :: Text
+  { deploymentMetadataKey :: Text -- ^ The name of the link
+  , deploymentMetadataValue :: Text -- ^ The URL
   }
   deriving (Generic, Show, Eq)
   deriving (FromJSON, ToJSON) via Snake DeploymentMetadata

octopod-frontend/octopod-frontend.cabal

@@ -33,6 +33,7 @@ executable frontend
                      , Page.Popup.EditDeployment
                      , Page.Popup.NewDeployment
                      , Servant.Reflex.Extra
+                     , Page.Elements.Links
   ghc-options:         -Wall
                        -Werror
                        -Wno-missing-home-modules

octopod-frontend/src/Page/Deployment.hs

@@ -22,6 +22,7 @@ import           Frontend.API
 import           Frontend.Route
 import           Frontend.Utils
 import           Page.ClassicPopup
+import           Page.Elements.Links
 import           Page.Popup.EditDeployment
 
 -- | The root widget of a deployment page. It requests the deployment data.
@@ -68,7 +69,7 @@ deploymentWidget updEv dfi = mdo
       [ DPMError "Couldn't update status of deployment" <$ errEv
       , DPMClear <$ okEv ]
     deploymentBody updEv dfiDyn
-    pure (editEv')
+    pure editEv'
   sentEv <- editDeploymentPopup editEv never
   blank
 
@@ -161,14 +162,7 @@ deploymentBody updEv dfiDyn = deploymentBodyWrapper $ do
     elClass "h3" "deployment__sub-heading" $ text "Links"
     divClass "deployment__widget" $
       divClass "listing" $
-        void $ simpleList urlsDyn $ \urlDyn' -> do
-          let
-            urlDyn = deploymentMetadataValue <$> urlDyn'
-            attrDyn = urlDyn <&> \url ->
-              (  "class" =: "listing__item external bar bar--larger"
-              <> "href" =: url
-              <> "target" =: "_blank" )
-          elDynAttr "a" attrDyn $ dynText urlDyn
+        void $ simpleList urlsDyn renderMetadataLink
   elClass "section" "deployment__section" $ do
     let
       envsDyn = dfiDyn <^.> field @"deployment"

octopod-frontend/src/Page/Deployments.hs

@@ -29,6 +29,7 @@ import           Frontend.API
 import           Frontend.Route
 import           Frontend.Utils
 import           Page.ClassicPopup
+import           Page.Elements.Links
 import           Page.Popup.EditDeployment
 import           Page.Popup.NewDeployment
 
@@ -239,15 +240,7 @@ activeDeploymentWidget clickedEv dDyn' = do
       el "td" $ do
         text $ coerce dname
         statusWidget $ constDyn status
-      el "td" $ do
-        divClass "listing" $
-          forM_ metadata $ \meta -> do
-            let
-              url = deploymentMetadataValue meta
-            void $ elAttr' "a"
-              (  "class" =: "listing__item external bar"
-              <> "href" =: url
-              <> "target" =: "_blank") $ text url
+      el "td" $ divClass "listing" $ forM_ metadata (renderMetadataLink . pure)
       el "td" $
         text $ coerce $ deployment ^. field @"tag"
       el "td" $

octopod-frontend/src/Page/Elements/Links.hs

@@ -0,0 +1,23 @@
+module Page.Elements.Links
+  ( renderMetadataLink
+  ) where
+
+import           Common.Types
+import           Data.Functor
+import qualified Data.Text as T
+import           Reflex.Dom
+
+renderMetadataLink
+  :: (DomBuilder t m, PostBuild t m)
+  => Dynamic t DeploymentMetadata -> m ()
+renderMetadataLink metadataD = do
+  let
+    attrDyn = metadataD <&> \metadata ->
+      "class" =: "listing__item external bar bar--larger"
+      <> "href" =: deploymentMetadataValue metadata
+      <> "target" =: "_blank"
+  elDynAttr "a" attrDyn . dynText $ metadataD <&> \case
+    -- If the name is empty, then use the url
+    DeploymentMetadata {deploymentMetadataKey = name}
+      | (not . T.null . T.strip) name -> name
+    DeploymentMetadata {deploymentMetadataValue = url} -> url