Update to new lts

app/Env.hs

@@ -32,6 +32,7 @@ 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
 
 withEnv :: (Env () -> IO a) -> IO a
 withEnv action = do
@@ -90,8 +91,14 @@ withEnv action = do
   let cookieSettings = Cookies.defaultCookieSettings Deployment.onLocal (Just (realToFrac cookieSessionTTL))
   let sessionCookieKey = tShow Deployment.deployment <> "-share-session"
   redisConnection <- Redis.checkedConnect redisConfig
+  -- Set some very conservative defaults
+  let pgConnectionAcquisitionTimeout = Time.secondsToDiffTime 60 -- 1 minute
+  -- Helps prevent leaking connections if they somehow get forgotten about.
+  let pgConnectionMaxIdleTime = Time.secondsToDiffTime (60 * 5) -- 5 minutes
+  -- Limiting max lifetime helps cycle connections which may have accumulated memory cruft.
+  let pgConnectionMaxLifetime = Time.secondsToDiffTime (60 * 60) -- 1 hour
   pgConnectionPool <-
-    Pool.acquire postgresConnMax Nothing (Text.encodeUtf8 postgresConfig)
+    Pool.acquire postgresConnMax pgConnectionAcquisitionTimeout pgConnectionMaxLifetime pgConnectionMaxIdleTime  (Text.encodeUtf8 postgresConfig)
   timeCache <- FL.newTimeCache FL.simpleTimeFormat -- E.g. 05/Sep/2023:13:23:56 -0700
   sandboxedRuntime <- RT.startRuntime True RT.Persistent "share"
   let requestCtx = ()

src/Share/Backend.hs

@@ -35,7 +35,6 @@ module Share.Backend
 where
 
 import Control.Lens hiding ((??))
-import Control.Monad.Except
 import Data.List qualified as List
 import Data.Map qualified as Map
 import Share.Codebase (CodebaseM)

src/Share/Postgres/Contributions/Queries.hs

@@ -20,7 +20,6 @@ module Share.Postgres.Contributions.Queries
 where
 
 import Control.Lens
-import Control.Monad.Except
 import Data.List qualified as List
 import Data.Map qualified as Map
 import Data.Set qualified as Set

src/Share/Postgres/Tickets/Queries.hs

@@ -18,7 +18,6 @@ module Share.Postgres.Tickets.Queries
 where
 
 import Control.Lens
-import Control.Monad.Except
 import Data.List qualified as List
 import Data.Time (UTCTime)
 import Safe (lastMay)

src/Share/Web/Authentication/AccessToken.hs

@@ -5,7 +5,7 @@
 module Share.Web.Authentication.AccessToken where
 
 import Control.Lens hiding ((.=))
-import Crypto.JWT
+import Crypto.JWT qualified as Crypto.JWT
 import Data.Aeson qualified as Aeson
 import Data.Map qualified as Map
 import Data.Set qualified as Set
@@ -22,7 +22,7 @@ import Share.Postgres.Ops qualified as PGO
 import Share.Prelude
 import Share.User
 import Share.Web.App
-import Share.Web.Authentication.JWT (verifyJWT)
+import Share.Web.Authentication.JWT qualified as Auth.JWT
 import Share.Web.Authentication.JWT qualified as AuthJWT
 import Share.Web.Authentication.JWT qualified as JWT
 import Share.Web.Authentication.Types
@@ -46,7 +46,7 @@ instance ToJWT AccessTokenClaims where
     JWT.encodeStandardClaims standardClaims (Map.fromList [("scope", Aeson.toJSON scope)])
 
 instance FromJWT AccessTokenClaims where
-  decodeJWT :: ClaimsSet -> Either Text AccessTokenClaims
+  decodeJWT :: Crypto.JWT.ClaimsSet -> Either Text AccessTokenClaims
   decodeJWT claims = do
     (standardClaims, extra) <- JWT.decodeStandardClaims claims
     scope <- fromMaybe (Left "Invalid scope") (extra ^? ix "scope" . to (resultEither . Aeson.fromJSON))
@@ -59,7 +59,7 @@ instance FromJWT AccessTokenClaims where
 -- | A version of verifyAccessToken which returns an Either rather than throwing an exception.
 verifyAccessToken' :: Scopes -> AccessToken -> AppM reqCtx (Either AuthenticationErr AccessTokenClaims)
 verifyAccessToken' (Scopes requiredScopes) (AccessToken (JWTParam signed)) = do
-  verifyJWT signed extraClaimsChecks
+  Auth.JWT.verifyJWT signed extraClaimsChecks
   where
     extraClaimsChecks (AccessTokenClaims {scope = Scopes tokenScopes}) =
       let missingScopes = Set.difference requiredScopes tokenScopes

src/Share/Web/UCM/Sync/Impl.hs

@@ -14,21 +14,13 @@ where
 
 import Control.Lens
 import Control.Monad.Except (ExceptT (ExceptT), runExceptT)
-import Control.Monad.Validate (ValidateT)
-import Control.Monad.Validate qualified as Validate
 import Data.Foldable qualified as Foldable
-import Data.Generics.Product
 import Data.List.NonEmpty qualified as NEL
-import Data.List.NonEmpty qualified as NEList
 import Data.Map.NonEmpty (NEMap)
 import Data.Map.NonEmpty qualified as NEMap
-import Data.Map.Strict qualified as Map
 import Data.Set qualified as Set
 import Data.Set.NonEmpty (NESet)
 import Data.Set.NonEmpty qualified as NESet
-import Data.Text qualified as Text
-import Data.Text.Lazy qualified as LT
-import Data.Text.Lazy.Encoding qualified as LT
 import Servant
 import Share.App
 import Share.Codebase (CodebaseM)
@@ -40,11 +32,8 @@ import Share.IDs qualified as IDs
 import Share.OAuth.Session (Session (..))
 import Share.Postgres qualified as PG
 import Share.Postgres.Causal.Queries qualified as CausalQ
-import Share.Postgres.Causal.Types
-import Share.Postgres.Definitions.Queries qualified as Defn
 import Share.Postgres.Hashes.Queries qualified as HashQ
 import Share.Postgres.IDs
-import Share.Postgres.LooseCode.Queries qualified as LCQ
 import Share.Postgres.Queries qualified as PGQ
 import Share.Postgres.Sync.Queries (entityLocations)
 import Share.Postgres.Sync.Queries qualified as SyncQ
@@ -61,7 +50,6 @@ import Share.Web.Errors
 import Share.Web.UCM.Sync.HashJWT qualified as HashJWT
 import Share.Web.UCM.Sync.Types (EntityBunch (..), EntityKind (..), entityKind)
 import U.Codebase.Causal qualified as Causal
-import U.Codebase.Sqlite.Branch.Full qualified as BranchFull
 import U.Codebase.Sqlite.Orphans ()
 import Unison.Codebase.Path qualified as Path
 import Unison.Hash32 (Hash32)
@@ -70,12 +58,11 @@ import Unison.NameSegment.Internal qualified as UNameSegment
 import Unison.Share.API.Hash (HashJWTClaims (..))
 import Unison.Share.API.Hash qualified as Hash
 import Unison.Sync.API qualified as Sync
-import Unison.Sync.Common (causalHashToHash32, hash32ToCausalHash)
+import Unison.Sync.Common (causalHashToHash32)
 import Unison.Sync.EntityValidation qualified as Sync
-import Unison.Sync.Types (DownloadEntitiesError (..), DownloadEntitiesRequest (..), DownloadEntitiesResponse (..),  GetCausalHashByPathRequest (..), GetCausalHashByPathResponse (..), NeedDependencies (..), RepoInfo (..), UpdatePathRequest (..), UpdatePathResponse, UploadEntitiesError (..), UploadEntitiesRequest (..), UploadEntitiesResponse (..), pathCodebasePath, pathRepoInfo)
+import Unison.Sync.Types (DownloadEntitiesError (..), DownloadEntitiesRequest (..), DownloadEntitiesResponse (..), GetCausalHashByPathRequest (..), GetCausalHashByPathResponse (..), NeedDependencies (..), RepoInfo (..), UploadEntitiesError (..), UploadEntitiesRequest (..), UploadEntitiesResponse (..))
 import Unison.Sync.Types qualified as Share
 import Unison.Sync.Types qualified as Sync
-import UnliftIO (MonadUnliftIO (withRunInIO))
 import UnliftIO qualified
 
 data RepoInfoKind

src/Unison/Server/Share/Definitions.hs

@@ -11,7 +11,6 @@ module Unison.Server.Share.Definitions
 where
 
 import Control.Lens hiding ((??))
-import Control.Monad.Except
 import Data.Bifoldable (bifoldMap)
 import Data.Either (partitionEithers)
 import Data.List qualified as List

src/Unison/Server/Share/FuzzyFind.hs

@@ -11,7 +11,6 @@
 module Unison.Server.Share.FuzzyFind where
 
 import Control.Lens
-import Control.Monad.Except
 import Data.Aeson
 import Data.Aeson qualified as Aeson
 import Data.Char qualified as Char

src/Unison/Server/Share/NamespaceDetails.hs

@@ -1,6 +1,5 @@
 module Unison.Server.Share.NamespaceDetails (namespaceDetails) where
 
-import Control.Monad.Except
 import Data.Set qualified as Set
 import Share.Codebase qualified as Codebase
 import Share.Codebase.Types (CodebaseM, CodebaseRuntime)

src/Unison/Server/Share/NamespaceListing.hs

@@ -5,17 +5,16 @@
 
 module Unison.Server.Share.NamespaceListing (serve, NamespaceListingAPI, NamespaceListing (..), NamespaceObject (..), NamedNamespace (..), NamedPatch (..), KindExpression (..)) where
 
-import Control.Monad.Except
 import Data.Aeson
+import Servant
+  ( QueryParam,
+    (:>),
+  )
 import Share.Backend qualified as Backend
 import Share.Codebase (CodebaseM)
 import Share.Codebase qualified as Codebase
 import Share.Postgres.IDs (CausalId)
 import Share.Prelude
-import Servant
-  ( QueryParam,
-    (:>),
-  )
 import U.Codebase.Branch (NamespaceStats (..))
 import U.Codebase.Causal qualified as V2Causal
 import U.Codebase.HashTags (CausalHash (..))

src/Unison/Server/Share/RenderDoc.hs

@@ -10,7 +10,6 @@
 -- | Helper for rendering docs within a given namespace
 module Unison.Server.Share.RenderDoc where
 
-import Control.Monad.Except
 import Data.Set qualified as Set
 import Share.Backend qualified as Backend
 import Share.Codebase.Types (CodebaseM, CodebaseRuntime)