Packagify share api

Makefile

@@ -27,7 +27,7 @@ endif
 $(target_dir):
 	mkdir $@
 
-$(exe): $(shell find . unison -type f -name '*.hs') package.yaml stack.yaml
+$(exe): $(shell find . unison -type f -name '*.hs') $(shell find . unison -type f -name '*.yaml')
 	@echo $(exe)
 	@echo $@
 	stack build $(STACK_FLAGS) share-api:share-api

share-api/README.md

@@ -0,0 +1 @@
+See root README

app/Main.hs → share-api/app/Main.hs

@@ -1,7 +1,7 @@
 module Main where
 
 import Share
-import Env (withEnv)
+import Share.Env (withEnv)
 
 main :: IO ()
 main = do

share-api.cabal → share-api/share-api.cabal

@@ -12,8 +12,6 @@ bug-reports:    https://github.com/unisoncomputing/share-api/issues
 author:         Unison Computing
 maintainer:     unison.cloud
 copyright:      2024 Unison Computing
-license:        MIT
-license-file:   LICENSE
 build-type:     Simple
 extra-source-files:
     README.md
@@ -51,6 +49,7 @@ library
       Share.Codebase.Types
       Share.Contribution
       Share.Env
+      Share.Env.Types
       Share.Github
       Share.IDs
       Share.Metrics
@@ -368,7 +367,6 @@ library
 executable share-api
   main-is: Main.hs
   other-modules:
-      Env
       Paths_share_api
   hs-source-dirs:
       app

src/Share.hs → share-api/src/Share.hs

@@ -37,7 +37,7 @@ import Servant
 import Share.App
 import Share.BackgroundJobs qualified as BackgroundJobs
 import Share.BackgroundJobs.Monad (runBackground)
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.IDs (RequestId, UserId)
 import Share.IDs qualified as IDs
 import Share.JWT qualified as JWT

src/Share/App.hs → share-api/src/Share/App.hs

@@ -15,8 +15,8 @@ import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Database.Redis qualified as R
 import OpenTelemetry.Trace.Monad (MonadTracer (..))
-import Share.Env (Env (..))
-import Share.Env qualified as Env
+import Share.Env.Types (Env (..))
+import Share.Env.Types qualified as Env
 import Share.JWT.Types (Audience (..), Issuer (..))
 import Share.Prelude
 import Share.Utils.Logging qualified as Logging

src/Share/BackgroundJobs/Diffs/CausalDiffs.hs → share-api/src/Share/BackgroundJobs/Diffs/CausalDiffs.hs

@@ -10,7 +10,7 @@ import Share.BackgroundJobs.Monad (Background)
 import Share.BackgroundJobs.Workers (newWorker)
 import Share.Codebase qualified as Codebase
 import Share.Codebase.CodebaseRuntime qualified as CR
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.IDs qualified as IDs
 import Share.Metrics qualified as Metrics
 import Share.Postgres qualified as PG

src/Share/BackgroundJobs/Errors.hs → share-api/src/Share/BackgroundJobs/Errors.hs

@@ -12,7 +12,7 @@ import Control.Monad.Except
 import Data.HashMap.Lazy qualified as HM
 import Data.Typeable qualified as Typeable
 import Share.BackgroundJobs.Monad
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.Monitoring qualified as Monitoring
 import Share.Prelude
 import Share.Utils.Logging (Loggable)

src/Share/BackgroundJobs/Monad.hs → share-api/src/Share/BackgroundJobs/Monad.hs

@@ -10,7 +10,7 @@ module Share.BackgroundJobs.Monad
 where
 
 import Share.App
-import Share.Env
+import Share.Env.Types
 import Share.Prelude
 import Share.Utils.Tags (HasTags (..))
 

src/Share/BackgroundJobs/Webhooks/Worker.hs → share-api/src/Share/BackgroundJobs/Webhooks/Worker.hs

@@ -26,7 +26,7 @@ import Share.BackgroundJobs.Workers (newWorker)
 import Share.ChatApps (Author (..))
 import Share.ChatApps qualified as ChatApps
 import Share.Contribution (displayContributionStatus)
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.IDs
 import Share.IDs qualified as IDs
 import Share.JWT (JWTParam (..))

src/Share/ChatApps.hs → share-api/src/Share/ChatApps.hs

@@ -25,7 +25,7 @@ import Network.HTTP.Types qualified as HTTP
 import Network.URI (URI)
 import Network.URI qualified as URI
 import Share.App (AppM)
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.IDs
 import Share.Postgres qualified as PG
 import Share.Postgres.Users.Queries qualified as UsersQ

app/Env.hs → share-api/src/Share/Env.hs

@@ -1,43 +1,43 @@
 {-# LANGUAGE RecordWildCards #-}
 
-module Env
+module Share.Env
   ( withEnv,
   )
 where
 
-import qualified Share.Telemetry.Setup as Telemetry
 import Data.ByteString.Char8 qualified as BS
 import Data.Char
 import Data.Char qualified as Char
 import Data.Either.Combinators
-import Data.Map qualified as Map
 import Data.Functor
 import Data.HashMap.Strict qualified as HM
+import Data.Map qualified as Map
 import Data.Set qualified as Set
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
+import Data.Time.Clock qualified as Time
 import Database.Redis qualified as Redis
-import Share.Env
+import Hasql.Pool qualified as Pool
+import Hasql.Pool.Config qualified as Pool
+import Network.HTTP.Client qualified as HTTPClient
+import Network.HTTP.Client.TLS qualified as TLS
+import Network.URI (parseURI)
+import Servant.Client qualified as ServantClient
+import Share.Env.Types
 import Share.JWT qualified as JWT
 import Share.Prelude
+import Share.Telemetry.Setup qualified as Telemetry
 import Share.Utils.Deployment qualified as Deployment
 import Share.Utils.Logging qualified as Logging
 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 Servant.Client qualified as ServantClient
 import System.Environment (lookupEnv)
 import System.Exit
 import System.Log.FastLogger qualified as FL
 import System.Log.Raven qualified as Sentry
 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
 
 withEnv :: (Env () -> IO a) -> IO a
@@ -100,18 +100,21 @@ withEnv action = do
   let acceptedIssuers = Set.fromList [shareIssuer, cloudIssuer]
   let legacyKey = JWT.KeyDescription {JWT.key = hs256Key, JWT.alg = JWT.HS256}
   let signingKey = JWT.KeyDescription {JWT.key = edDSAKey, JWT.alg = JWT.Ed25519}
-  let externalJWKs = Map.fromList [ (cloudIssuer, Left cloudAPIJWKEndpoint)
-                                  ]
+  let externalJWKs =
+        Map.fromList
+          [ (cloudIssuer, Left cloudAPIJWKEndpoint)
+          ]
   hashJWTJWK <- case JWT.keyDescToJWK legacyKey of
     Left err -> throwIO err
     Right jwk -> pure jwk
   -- I explicitly add the legacy key to the validation keys, so that the thumbprinted
   -- version of the key is used for validation, which is needed for HashJWTs which are signed
   -- with a 'kid'.
   let validationKeys = Set.fromList [legacyKey]
-  jwtSettings <- JWT.defaultJWTSettings shareIssuer signingKey (Just legacyKey) validationKeys acceptedAudiences acceptedIssuers externalJWKs >>= \case
-    Left cryptoError -> throwIO cryptoError
-    Right settings -> pure settings
+  jwtSettings <-
+    JWT.defaultJWTSettings shareIssuer signingKey (Just legacyKey) validationKeys acceptedAudiences acceptedIssuers externalJWKs >>= \case
+      Left cryptoError -> throwIO cryptoError
+      Right settings -> pure settings
   let cookieSettings = Cookies.defaultCookieSettings Deployment.onLocal (Just (realToFrac cookieSessionTTL))
   let sessionCookieKey = tShow Deployment.deployment <> "-share-session"
   redisConnection <- Redis.checkedConnect redisConfig
@@ -133,21 +136,19 @@ withEnv action = do
   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" ((fmap . fmap) Text.encodeUtf8 . nonEmptyTextParser "SHARE_PROXY_HOST")
-          httpProxyPort <- fromEnv "SHARE_PROXY_PORT" (pure . maybeToEither "Invalid SHARE_PROXY_PORT" . readMaybe)
+    if Deployment.onLocal
+      then TLS.newTlsManager
+      else do
+        httpProxyHost <- fromEnv "SHARE_PROXY_HOST" ((fmap . fmap) Text.encodeUtf8 . nonEmptyTextParser "SHARE_PROXY_HOST")
+        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
+        -- 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
+        TLS.newTlsManagerWith proxiedManagerSettings
 
   -- Logging setup
   let ctx = ()
@@ -157,27 +158,28 @@ withEnv action = do
   Telemetry.withTracer commitHash \tracer -> do
     FL.withFastLogger (FL.LogStderr FL.defaultBufSize) $ \logger -> 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
+  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
+    parseBaseUrl :: String -> IO (Either String ServantClient.BaseUrl)
+    parseBaseUrl str = do
+      u <- ServantClient.parseBaseUrl str
+      pure $ Right u
 
 -- | Parse an environment variable, but only if it exists.
 maybeEnv :: String -> (String -> IO (Either String a)) -> IO (Maybe a)
 maybeEnv var parser = do
   val <- lookupEnv var
   case val of
     Nothing -> pure Nothing
-    Just val' -> parser val' >>= \case
-      Right a -> pure (Just a)
-      Left err -> putStrLn ("Error with " <> var <> ": " <> err) >> exitWith (ExitFailure 1)
+    Just val' ->
+      parser val' >>= \case
+        Right a -> pure (Just a)
+        Left err -> putStrLn ("Error with " <> var <> ": " <> err) >> exitWith (ExitFailure 1)
 
 fromEnv :: String -> (String -> IO (Either String a)) -> IO a
 fromEnv var from = do

src/Share/Env.hs → share-api/src/Share/Env/Types.hs

@@ -1,4 +1,4 @@
-module Share.Env
+module Share.Env.Types
   ( Env (..),
     serviceName,
   )

src/Share/Github.hs → share-api/src/Share/Github.hs

@@ -12,7 +12,7 @@ import Network.HTTP.Types (Status (..))
 import Network.URI (URIAuth (URIAuth))
 import Servant
 import Servant.Client
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.OAuth.Types (OAuth2State)
 import Share.OAuth.Types qualified as OAuth2
 import Share.Prelude

src/Share/Metrics.hs → share-api/src/Share/Metrics.hs

@@ -26,7 +26,7 @@ import Network.Wai qualified as Wai
 import Network.Wai.Middleware.Prometheus qualified as Prom
 import Prometheus qualified as Prom
 import Prometheus.Metric.GHC qualified as Prom
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.Postgres qualified as PG
 import Share.Postgres.Metrics.Queries qualified as Q
 import Share.Prelude

src/Share/Monitoring.hs → share-api/src/Share/Monitoring.hs

@@ -5,14 +5,14 @@ import Data.Aeson qualified as Aeson
 import Data.HashMap.Strict qualified as HM
 import Data.Map qualified as Map
 import Data.Text qualified as Text
-import Share.Env
-import Share.Env qualified as Env
+import GHC.Stack qualified as Stack
+import Network.URI (URI)
+import Share.Env.Types
+import Share.Env.Types qualified as Env
 import Share.Prelude
 import Share.Utils.Deployment qualified as Deployment
 import Share.Utils.Logging
 import Share.Utils.Logging qualified as Logging
-import GHC.Stack qualified as Stack
-import Network.URI (URI)
 import System.Log.Raven qualified as Sentry
 import System.Log.Raven.Types qualified as Sentry
 

src/Share/Notifications/Webhooks/Secrets.hs → share-api/src/Share/Notifications/Webhooks/Secrets.hs

@@ -18,7 +18,7 @@ import Servant.Client (ClientError, ClientM)
 import Servant.Client qualified as ServantClient
 import Servant.Server (err500)
 import Share.App (AppM)
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.IDs 
 import Share.IDs qualified as IDs
 import Share.Prelude

src/Share/Postgres.hs → share-api/src/Share/Postgres.hs

@@ -113,7 +113,7 @@ import OpenTelemetry.Trace qualified as Trace
 import OpenTelemetry.Trace.Monad (MonadTracer (..))
 import Safe (headMay)
 import Share.Debug qualified as Debug
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.Postgres.Composites
 import Share.Postgres.Orphans ()
 import Share.Prelude

src/Share/Utils/Logging.hs → share-api/src/Share/Utils/Logging.hs

@@ -46,7 +46,7 @@ import Data.Text.Encoding qualified as Text
 import Data.Text.IO qualified as Text
 import GHC.Stack (CallStack, callStack, prettyCallStack)
 import Servant.Client qualified as Servant
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.OAuth.Errors (OAuth2Error)
 import Share.OAuth.Types (RedirectReceiverErr)
 import Share.Prelude

src/Share/Web/App.hs → share-api/src/Share/Web/App.hs

@@ -20,7 +20,7 @@ import Network.URI
 import Servant
 import Servant.Server.Generic (AsServerT)
 import Share.App
-import Share.Env
+import Share.Env.Types
 import Share.IDs (RequestId, UserId)
 import Share.Prelude
 import Share.Utils.Tags

src/Share/Web/Authentication/HashJWT.hs → share-api/src/Share/Web/Authentication/HashJWT.hs

@@ -2,7 +2,7 @@ module Share.Web.Authentication.HashJWT where
 
 import Crypto.JWT
 import Data.Aeson qualified as Aeson
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.JWT qualified as JWT
 import Share.Prelude
 import Share.Web.App

src/Share/Web/Authentication/JWT.hs → share-api/src/Share/Web/Authentication/JWT.hs

@@ -8,7 +8,7 @@ import Crypto.JWT (SignedJWT)
 import Data.Either.Combinators qualified as Either
 import Data.Time (NominalDiffTime, addUTCTime, getCurrentTime)
 import Share.App
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.IDs (JTI (..), SessionId (..), UserId (..))
 import Share.IDs qualified as IDs
 import Share.JWT

src/Share/Web/Errors.hs → share-api/src/Share/Web/Errors.hs

@@ -55,7 +55,7 @@ import GHC.Stack qualified as GHC
 import GHC.TypeLits qualified as TL
 import Servant
 import Servant.Client
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.Monitoring qualified as Monitoring
 import Share.OAuth.Errors (OAuth2Error (..), OAuth2ErrorCode (..), OAuth2ErrorRedirect (..))
 import Share.OAuth.Types (AuthenticationRequest (..), RedirectReceiverErr (..))
@@ -404,7 +404,6 @@ throwSomeServerError = throwError . SomeServerError . withCallstack
 
 -- Instances from unison types.
 
-
 instance ToServerError Sync.EntityValidationError where
   toServerError = \case
     Sync.EntityHashMismatch {} -> ("entity-hash-mismatch", err500)
@@ -424,5 +423,3 @@ instance ToServerError Sync.UploadEntitiesError where
     Sync.UploadEntitiesError'NoWritePermission _ -> ("no-write-permission", err403 {errBody = "No Write Permission"})
     Sync.UploadEntitiesError'ProjectNotFound _ -> ("project-not-found", err404 {errBody = "Project Not Found"})
     Sync.UploadEntitiesError'UserNotFound _ -> ("user-not-found", err404 {errBody = "User Not Found"})
-
-

src/Share/Web/Impl.hs → share-api/src/Share/Web/Impl.hs

@@ -6,7 +6,7 @@ import Crypto.JOSE.JWK qualified as JWK
 import Data.Set qualified as Set
 import Servant
 import Share.App
-import Share.Env qualified as Env
+import Share.Env.Types qualified as Env
 import Share.JWT qualified as JWT
 import Share.JWT.Types (Issuer (..))
 import Share.OAuth.Session