Staging megamerge

Author: ChrisPenner

.github/workflows/ci.yaml

@@ -249,6 +249,7 @@ jobs:
           # Start share and it's dependencies in the background
           docker compose -f docker/docker-compose.yml up --wait
 
+
           # Run the transcript tests
           zsh ./transcripts/run-transcripts.zsh
 

Makefile

@@ -53,8 +53,8 @@ docker_staging_push: $(docker_server_release)
 
 serve: $(installed_share)
 	trap 'docker compose -f docker/docker-compose.yml down' EXIT INT TERM
-	docker compose -f docker/docker-compose.yml up postgres redis &
-	while  ! (  pg_isready --host localhost -U postgres -p 5432 && redis-cli -p 6379 ping)  do \
+	docker compose -f docker/docker-compose.yml up postgres redis vault &
+	while  ! (  pg_isready --host localhost -U postgres -p 5432 && redis-cli -p 6379 ping && VAULT_ADDR=http://localhost:8200 vault status)  do \
 		echo "Waiting for postgres and redis..."; \
 	  sleep 1; \
 	done;

app/Env.hs

@@ -24,8 +24,9 @@ import Share.Utils.Servant.Cookies qualified as Cookies
 import Share.Web.Authentication (cookieSessionTTL)
 import Hasql.Pool qualified as Pool
 import Hasql.Pool.Config qualified as Pool
-import Network.URI (parseURI)
+import Network.URI (parseURI, uriScheme)
 import Servant.API qualified as Servant
+import Servant.Client qualified as ServantClient
 import System.Environment (lookupEnv)
 import System.Exit
 import System.Log.FastLogger qualified as FL
@@ -34,6 +35,10 @@ import System.Log.Raven.Transport.HttpConduit qualified as Sentry
 import System.Log.Raven.Types qualified as Sentry
 import Unison.Runtime.Interface as RT
 import Data.Time.Clock qualified as Time
+import Network.HTTP.Client.TLS qualified as TLS
+import Network.HTTP.Client qualified as HTTPClient
+import Vault qualified
+import Data.ByteString.Char8 qualified as BSC
 
 withEnv :: (Env () -> IO a) -> IO a
 withEnv action = do
@@ -114,6 +119,35 @@ withEnv action = do
   pgConnectionPool <- Pool.acquire pgSettings
   timeCache <- FL.newTimeCache FL.simpleTimeFormat -- E.g. 05/Sep/2023:13:23:56 -0700
   sandboxedRuntime <- RT.startRuntime True RT.Persistent "share"
+
+  -- Vault setup
+  unproxiedHttpClient <- TLS.newTlsManager
+  vaultHost <- fromEnv "VAULT_HOST" parseBaseUrl
+  userSecretsVaultMount <- fromEnv "USER_SECRETS_VAULT_MOUNT" ((fmap . fmap) Vault.SecretMount . nonEmptyTextParser "USER_SECRETS_VAULT_MOUNT")
+  shareVaultToken <- fromEnv "VAULT_TOKEN" ((fmap . fmap) Vault.VaultToken . nonEmptyTextParser "VAULT_TOKEN")
+  let vaultClientEnv = ServantClient.mkClientEnv unproxiedHttpClient vaultHost
+
+
+
+  proxiedHttpClient <- do
+    if  Deployment.onLocal
+       then TLS.newTlsManager
+       else do
+          httpProxyHost <- fromEnv "SHARE_PROXY_HOST" (\proxyHost -> case parseURI proxyHost of
+            Nothing -> pure $ Left "Invalid SHARE_PROXY_ADDRESS"
+            Just uri -> if uriScheme uri == "http:" || uriScheme uri == "https:"
+              then pure $ Right (BSC.pack proxyHost)
+              else pure $ Left "SHARE_PROXY_ADDRESS must be http or https")
+          httpProxyPort <- fromEnv "SHARE_PROXY_PORT" (pure . maybeToEither "Invalid SHARE_PROXY_PORT" . readMaybe)
+
+          -- http proxy setup
+          let proxyOverride = HTTPClient.useProxy (HTTPClient.Proxy{HTTPClient.proxyHost = httpProxyHost, HTTPClient.proxyPort = httpProxyPort})
+          let proxiedManagerSettings =
+                TLS.tlsManagerSettings
+                & HTTPClient.managerSetProxy proxyOverride
+          TLS.newTlsManagerWith proxiedManagerSettings
+
+  -- Logging setup
   let ctx = ()
   -- We use a zero-width-space to separate log-lines on ingestion, this allows us to use newlines for
   -- formatting, but without affecting log-grouping.
@@ -122,6 +156,15 @@ withEnv action = do
     action $ Env {logger = (logger . (\msg -> zeroWidthSpace <> msg <> "\n")), ..}
   where
     readPort p = pure $ maybeToRight "SHARE_PORT was not a number" (readMaybe p)
+    nonEmptyTextParser :: Text -> String -> IO (Either String Text)
+    nonEmptyTextParser varName = \case
+      "" -> pure . Left . Text.unpack $ "Expected a value for env var " <> varName <> ", but got an empty string"
+      str -> pure . Right $ Text.pack str
+
+    parseBaseUrl :: String -> IO (Either String ServantClient.BaseUrl)
+    parseBaseUrl str = do
+      u <- ServantClient.parseBaseUrl str
+      pure $ Right u
 
 fromEnv :: String -> (String -> IO (Either String a)) -> IO a
 fromEnv var from = do

docker/docker-compose.yml

@@ -32,12 +32,37 @@ services:
     ports:
      - "6379:6379"
 
+  vault:
+    image: 'hashicorp/vault:1.19'
+    container_name: vault
+    healthcheck:
+      test: ["CMD", "vault", "status"]
+      interval: 3s
+      timeout: 10s
+      retries: 3
+    ports:
+      - "8200:8200"
+    environment:
+      VAULT_DEV_ROOT_TOKEN_ID: "sekrit"
+      VAULT_KV_V1_MOUNT_PATH: "secret"
+      VAULT_ADDR: "http://127.0.0.1:8200"
+    cap_add:
+      - IPC_LOCK
+    # # Use kv version 1
+    # command: server -dev
+
   share:
     image: share-api
     container_name: share-api
     depends_on:
-      - redis
-      - postgres
+          redis:
+            condition: service_healthy
+          postgres:
+            condition: service_healthy
+          vault:
+            condition: service_healthy
+          http-echo:
+            condition: service_started
     healthcheck:
       test: ["CMD", "curl", "-f", "http://localhost:5424/health"]
       interval: 3s
@@ -53,10 +78,10 @@ services:
       - SHARE_SERVER_PORT=5424
       - SHARE_REDIS=redis://redis:6379
       - SHARE_POSTGRES=postgresql://postgres:sekrit@postgres:5432
-      - SHARE_HMAC_KEY=hmac-key-test-key-test-key-test-
-      - SHARE_EDDSA_KEY=eddsa-key-test-key-test-key-test
       - SHARE_POSTGRES_CONN_TTL=30
       - SHARE_POSTGRES_CONN_MAX=10
+      - SHARE_HMAC_KEY=hmac-key-test-key-test-key-test-
+      - SHARE_EDDSA_KEY=eddsa-key-test-key-test-key-test
       - SHARE_SHARE_UI_ORIGIN=http://localhost:1234
       - SHARE_CLOUD_UI_ORIGIN=http://localhost:5678
       - SHARE_HOMEPAGE_ORIGIN=http://localhost:1111
@@ -65,6 +90,9 @@ services:
       - SHARE_COMMIT=dev
       - SHARE_MAX_PARALLELISM_PER_DOWNLOAD_REQUEST=1
       - SHARE_MAX_PARALLELISM_PER_UPLOAD_REQUEST=5
+      - VAULT_HOST=http://vault:8200/v1
+      - VAULT_TOKEN=sekrit
+      - USER_SECRETS_VAULT_MOUNT=secret # A default mount in dev vault
       - SHARE_ZENDESK_API_USER=invaliduser@example.com
       - SHARE_ZENDESK_API_TOKEN=bad-password
       - SHARE_GITHUB_CLIENTID=invalid
@@ -73,6 +101,17 @@ services:
     links:
       - redis
       - postgres
+      - vault
+      - http-echo
+
+  http-echo:
+    image: 'mendhak/http-https-echo:36'
+    container_name: http-echo
+    environment:
+      HTTP_PORT: 9999
+      ECHO_BACK_TO_CLIENT: "false"
+    ports:
+      - "9999:9999"
 
 # volumes:
 #   postgresVolume:

local.env

@@ -19,6 +19,12 @@ export SHARE_LOG_LEVEL="DEBUG"
 export SHARE_COMMIT="dev"
 export SHARE_MAX_PARALLELISM_PER_DOWNLOAD_REQUEST="1"
 export SHARE_MAX_PARALLELISM_PER_UPLOAD_REQUEST="5"
+export VAULT_HOST="http://localhost:8200/v1"
+export VAULT_TOKEN="sekrit"
+export USER_SECRETS_VAULT_MOUNT="secret" # A default mount in dev vault
+# Proxies aren't used locally, but are required in staging and production
+# export SHARE_PROXY_HOST="http://localhost" 
+# export SHARE_PROXY_PORT="9999"
 
 # Placeholders, these features don't work on localhost.
 export SHARE_ZENDESK_API_USER="invaliduser@example.com"

share-api.cabal

@@ -36,6 +36,9 @@ library
       Share.BackgroundJobs.Search.DefinitionSync.Types
       Share.BackgroundJobs.SerializedEntitiesMigration.Queries
       Share.BackgroundJobs.SerializedEntitiesMigration.Worker
+      Share.BackgroundJobs.Webhooks.Queries
+      Share.BackgroundJobs.Webhooks.Types
+      Share.BackgroundJobs.Webhooks.Worker
       Share.BackgroundJobs.Workers
       Share.Branch
       Share.Codebase
@@ -50,8 +53,10 @@ library
       Share.NamespaceDiffs
       Share.Notifications.API
       Share.Notifications.Impl
+      Share.Notifications.Ops
       Share.Notifications.Queries
       Share.Notifications.Types
+      Share.Notifications.Webhooks.Secrets
       Share.Postgres
       Share.Postgres.Admin
       Share.Postgres.Authorization.Queries

share-auth/src/Share/JWT/Types.hs

@@ -233,6 +233,7 @@ instance (Applicative m) => JWT.VerificationKeyStore m (JWT.JWSHeader ()) payloa
 
 -- | A newtype for JWTs which provides the appropriate encoding/decoding instances.
 newtype JWTParam = JWTParam JWT.SignedJWT
+  deriving newtype (Eq)
   deriving (Show) via (Censored JWTParam)
 
 instance ToHttpApiData JWTParam where

share-utils/package.yaml

@@ -69,13 +69,15 @@ dependencies:
 - cryptonite
 - http-api-data
 - http-types
+- http-media
 - jose
 - memory
 - network-uri
 - pretty-simple
 - random
 - servant-auth
 - servant-server
+- servant-client
 - text
 - time
 - uuid

share-utils/share-utils.cabal

@@ -33,6 +33,7 @@ library
       Share.Utils.Servant.Cookies
       Share.Utils.Show
       Share.Utils.URI
+      Vault
   other-modules:
       Paths_share_utils
   hs-source-dirs:
@@ -81,6 +82,7 @@ library
     , hasql
     , hasql-interpolate
     , http-api-data
+    , http-media
     , http-types
     , jose
     , lens
@@ -89,6 +91,7 @@ library
     , pretty-simple
     , random
     , servant-auth
+    , servant-client
     , servant-server
     , text
     , time

share-utils/src/Vault.hs

@@ -0,0 +1,101 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Vault
+  ( deleteSecret,
+    patchSecret,
+    putSecret,
+    fetchSecret,
+    SecretMount (..),
+    VaultToken (..),
+    SecretPath (..),
+    SecretRequest (..),
+    SecretResponse (..),
+    SecretData (..),
+    SecretPatch (..),
+    Options (..),
+  )
+where
+
+import Data.Aeson qualified as Aeson
+import Data.Map (Map)
+import Data.Text (Text)
+import GHC.Generics (Generic)
+import Network.HTTP.Media.MediaType qualified as MT
+import Servant
+import Servant.Client qualified as SC
+import Share.Utils.Show (Censored (..))
+
+type RequiredHeader = Header' '[Required, Strict]
+
+-- API definition
+type VaultAPI =
+  (RequiredHeader "X-Vault-Token" VaultToken :> Capture "mount" SecretMount :> "data" :> Capture "path" SecretPath :> DeleteNoContent)
+    :<|> (RequiredHeader "X-Vault-Token" VaultToken :> Capture "mount" SecretMount :> "data" :> Capture "path" SecretPath :> ReqBody '[JsonMergePatch] SecretPatch :> PatchNoContent)
+    :<|> (RequiredHeader "X-Vault-Token" VaultToken :> Capture "mount" SecretMount :> "data" :> Capture "path" SecretPath :> ReqBody '[JSON] SecretRequest :> PutNoContent)
+    :<|> (RequiredHeader "X-Vault-Token" VaultToken :> Capture "mount" SecretMount :> "data" :> Capture "path" SecretPath :> Get '[JSON] SecretResponse)
+
+vaultApi :: Proxy VaultAPI
+vaultApi = Proxy
+
+data JsonMergePatch
+
+instance Accept JsonMergePatch where
+  contentType _ = "application" MT.// "merge-patch+json"
+
+newtype SecretMount = SecretMount Text
+  deriving newtype (Show, Eq, Ord, FromHttpApiData, ToHttpApiData)
+
+newtype SecretPath = SecretPath Text
+  deriving newtype (Show, Eq, Ord, FromHttpApiData, ToHttpApiData)
+
+newtype VaultToken = VaultToken Text
+  deriving newtype (Eq, Ord, FromHttpApiData, ToHttpApiData)
+  deriving (Show) via Censored VaultToken
+
+deleteSecret :: VaultToken -> SecretMount -> SecretPath -> SC.ClientM NoContent
+patchSecret :: VaultToken -> SecretMount -> SecretPath -> SecretPatch -> SC.ClientM NoContent
+putSecret :: VaultToken -> SecretMount -> SecretPath -> SecretRequest -> SC.ClientM NoContent
+fetchSecret :: VaultToken -> SecretMount -> SecretPath -> SC.ClientM SecretResponse
+deleteSecret :<|> patchSecret :<|> putSecret :<|> fetchSecret = SC.client vaultApi
+
+-- Data types
+
+data SecretRequest = SecretRequest
+  { options :: Maybe Options,
+    data_ :: Aeson.Value
+  }
+  deriving (Generic)
+
+instance Aeson.ToJSON SecretRequest where
+  toJSON (SecretRequest options data_) = Aeson.object ["options" Aeson..= options, "data" Aeson..= data_]
+
+newtype Options = Options
+  { cas :: Int
+  }
+  deriving (Generic)
+
+instance Aeson.ToJSON Options
+
+newtype SecretResponse = SecretResponse
+  { -- yes, the data is nested under two separate "data" keys
+    data_ :: SecretData
+  }
+
+newtype SecretData = SecretData {data_ :: Aeson.Value}
+
+data SecretPatch = SecretPatch !(Maybe Options) !(Map Text (Maybe Text))
+
+instance MimeRender JsonMergePatch SecretPatch where
+  mimeRender _ (SecretPatch options data_) = Aeson.encode $ Aeson.object ["options" Aeson..= options, "data" Aeson..= data_]
+
+instance Aeson.FromJSON SecretResponse where
+  parseJSON = Aeson.withObject "SecretResponse" $ \o -> do
+    data_ <- o Aeson..: "data"
+    return $ SecretResponse {data_}
+
+instance Aeson.FromJSON SecretData where
+  parseJSON = Aeson.withObject "SecretData" $ \o -> do
+    data_ <- o Aeson..: "data"
+    return $ SecretData {data_}