Merge pull request #173 from unisoncomputing/bump-lts

Bump lts resolver

Author: ChrisPenner

.gitignore

@@ -23,3 +23,6 @@ prelude.output.md
 
 # Developers can customize their own local development setup
 /transcripts/fixtures/custom_projects.txt
+
+# Debugging output
+share.out

share-api/src/Share.hs

@@ -136,7 +136,7 @@ mkShareServer env = do
   pure waiApp
   where
     gzipSettings =
-      Gzip.def
+      Gzip.defaultGzipSettings
         { Gzip.gzipFiles = Gzip.GzipCompress,
           Gzip.gzipCheckMime = \mime -> Gzip.defaultCheckMime mime || mime == "application/cbor"
         }

share-api/src/Share/Env.hs

@@ -13,10 +13,12 @@ import Data.Functor
 import Data.HashMap.Strict qualified as HM
 import Data.Map qualified as Map
 import Data.Set qualified as Set
+import Data.String qualified as String
 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 Hasql.Connection qualified as Hasql
 import Hasql.Pool qualified as Pool
 import Hasql.Pool.Config qualified as Pool
 import Network.HTTP.Client qualified as HTTPClient
@@ -52,7 +54,7 @@ withEnv action = do
         '0' : _ -> False
         [] -> False
         _ -> True
-  postgresConfig <- fromEnv "SHARE_POSTGRES" (pure . Right . Text.pack)
+  postgresConfig <- fromEnv "SHARE_POSTGRES" (pure . Right . String.fromString @Hasql.Settings)
   postgresConnMax <- fromEnv "SHARE_POSTGRES_CONN_MAX" (pure . maybeToEither "Invalid SHARE_POSTGRES_CONN_MAX" . readMaybe)
   githubClientID <- fromEnv "SHARE_GITHUB_CLIENTID" (pure . Right . Text.pack)
   githubClientSecret <- fromEnv "SHARE_GITHUB_CLIENT_SECRET" (pure . Right . Text.pack)
@@ -124,7 +126,7 @@ withEnv action = do
   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
-  let pgSettings = Pool.settings [Pool.staticConnectionSettings (Text.encodeUtf8 postgresConfig), Pool.size postgresConnMax, Pool.acquisitionTimeout pgConnectionAcquisitionTimeout, Pool.idlenessTimeout pgConnectionMaxIdleTime, Pool.agingTimeout pgConnectionMaxLifetime]
+  let pgSettings = Pool.settings [Pool.staticConnectionSettings postgresConfig, Pool.size postgresConnMax, Pool.acquisitionTimeout pgConnectionAcquisitionTimeout, Pool.idlenessTimeout pgConnectionMaxIdleTime, Pool.agingTimeout pgConnectionMaxLifetime]
   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"

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

@@ -6,6 +6,7 @@ where
 
 import Crypto.JOSE.JWK qualified as JWK
 import Database.Redis qualified as R
+import Hasql.Connection qualified as Hasql
 import Hasql.Pool qualified as Hasql
 import Network.HTTP.Client qualified as HTTPClient
 import Network.URI (URI)
@@ -43,7 +44,7 @@ data Env ctx = Env
     proxiedHttpClient :: HTTPClient.Manager,
     serverPort :: Int,
     redisConfig :: R.ConnectInfo,
-    postgresConfig :: Text,
+    postgresConfig :: Hasql.Settings,
     githubClientID :: Text,
     githubClientSecret :: Text,
     jwtSettings :: JWT.JWTSettings,

share-api/src/Share/IDs.hs

@@ -520,9 +520,9 @@ newtype ReleaseId = ReleaseId UUID
 -- | Version for a release, e.g. "1.2.3". See also ReleaseShortHand which includes the
 -- 'releases/' prefix.
 data ReleaseVersion = ReleaseVersion
-  { major :: !Int64,
-    minor :: !Int64,
-    patch :: !Int64
+  { major :: !Int32,
+    minor :: !Int32,
+    patch :: !Int32
   }
   deriving stock (Eq, Ord, Show, Generic)
   deriving (FromHttpApiData, ToHttpApiData, ToJSON, FromJSON) via UsingID ReleaseVersion

share-api/src/Share/Notifications/Queries.hs

@@ -33,6 +33,7 @@ import Data.Foldable qualified as Foldable
 import Data.Ord (clamp)
 import Data.Set qualified as Set
 import Data.Set.NonEmpty (NESet)
+import Data.Time (UTCTime)
 import Share.Contribution
 import Share.IDs
 import Share.Notifications.API (GetHubEntriesCursor)
@@ -466,9 +467,9 @@ hydrateEventPayload = \case
                 commentAuthor
               }
       construct
-        <$> ( queryExpect1Row
+        <$> ( queryExpect1Row @(CommentId, Text, UTCTime)
                 [sql|
-                SELECT cc.comment_id, cc.content, cc.created_at, cc.updated_at
+                SELECT cc.comment_id, cc.content, cc.created_at
                 FROM comment_content cc
                 JOIN users author ON cc.author_id = author.id
                 WHERE cc.comment_id = #{commentId}

share-api/src/Share/Postgres.hs

@@ -264,17 +264,19 @@ data PostgresError
   deriving anyclass (Exception)
 
 instance ToServerError PostgresError where
-  toServerError (PostgresError err) =
-    let errId = case err of
-          Pool.ConnectionUsageError {} -> "connection-usage-error"
-          Pool.SessionUsageError {} -> "session-usage-error"
-          Pool.AcquisitionTimeoutUsageError {} -> "acquisition-timeout-usage-error"
-     in (ErrorID $ "postgres:pool:" <> errId, internalServerError)
+  toServerError = \case
+    (PostgresError err) ->
+      let errId = case err of
+            Pool.ConnectionUsageError {} -> "connection-usage-error"
+            Pool.SessionUsageError {} -> "session-usage-error"
+            Pool.AcquisitionTimeoutUsageError {} -> "acquisition-timeout-usage-error"
+       in (ErrorID $ "postgres:pool:" <> errId, internalServerError)
 
 instance Logging.Loggable PostgresError where
-  toLog (PostgresError err) =
-    Logging.showLog err
-      & Logging.withSeverity Logging.Error
+  toLog = \case
+    (PostgresError err) ->
+      Logging.showLog err
+        & Logging.withSeverity Logging.Error
 
 -- TODO: I think we want to vary this per transaction.
 defaultIsolationLevel :: IsolationLevel

share-api/src/Share/Postgres/Causal/Queries.hs

@@ -904,12 +904,12 @@ expectNamespaceStatsOf trav s =
         |]
             <&> fmap \(containedTerms, deepContainedTerms, containedTypes, deepContainedTypes, containedConstructors, deepContainedConstructors) ->
               NamespaceStats
-                { containedTerms = fromIntegral @Int64 @Int containedTerms,
-                  deepContainedTerms = fromIntegral @Int64 @Int deepContainedTerms,
-                  containedTypes = fromIntegral @Int64 @Int containedTypes,
-                  deepContainedTypes = fromIntegral @Int64 @Int deepContainedTypes,
-                  containedConstructors = fromIntegral @Int64 @Int containedConstructors,
-                  deepContainedConstructors = fromIntegral @Int64 @Int deepContainedConstructors
+                { containedTerms = fromIntegral @Int32 @Int containedTerms,
+                  deepContainedTerms = fromIntegral @Int32 @Int deepContainedTerms,
+                  containedTypes = fromIntegral @Int32 @Int containedTypes,
+                  deepContainedTypes = fromIntegral @Int32 @Int deepContainedTypes,
+                  containedConstructors = fromIntegral @Int32 @Int containedConstructors,
+                  deepContainedConstructors = fromIntegral @Int32 @Int deepContainedConstructors
                 }
       if length results /= length branchHashes
         then unrecoverableError $ MissingExpectedEntity ("namespaceStatsOf: Expected namespace stats for all hashes: " <> tShow branchHashes)
@@ -992,7 +992,7 @@ isFastForward fromCausalId toCausalId = do
 
 type CausalHistoryCursor = (CausalHash, CausalDepth)
 
-type CausalDepth = Int64
+type CausalDepth = Int32
 
 pagedCausalAncestors ::
   (QueryM m) =>

share-api/src/Share/Postgres/Definitions/Queries.hs

@@ -54,7 +54,6 @@ import Data.ByteString.Lazy.Char8 qualified as BL
 import Data.List.NonEmpty qualified as NE
 import Data.List.NonEmpty qualified as NonEmpty
 import Data.Set qualified as Set
-import Data.Text qualified as Text
 import Data.Vector qualified as Vector
 import Hasql.Decoders qualified as Decoders
 import Hasql.Interpolate qualified as Hasql
@@ -627,7 +626,7 @@ constructorReferentsByPrefix ::
 constructorReferentsByPrefix prefix mayComponentIndex mayConstructorIndex = do
   let mayComponentIndex' = pgComponentIndex <$> mayComponentIndex
   let mayConstructorIndex' = pgConstructorIndex <$> mayConstructorIndex
-  queryListRows @(Hash, PgComponentIndex, Text, PgConstructorIndex)
+  queryListRows @(Hash, PgComponentIndex, DeclKindEnum, PgConstructorIndex)
     [sql| SELECT component_hashes.base32, typ.component_index, typ.kind, constr.constructor_index
         FROM component_hashes
           JOIN types typ ON component_hashes.id = typ.component_hash_id
@@ -640,9 +639,8 @@ constructorReferentsByPrefix prefix mayComponentIndex mayConstructorIndex = do
     <&> fmap
       ( \(hash, componentIndex, declKind, constructorIndex) ->
           let dt = case declKind of
-                "data" -> CT.Data
-                "ability" -> CT.Effect
-                kind -> error $ "declReferentsByPrefix: Unknown decl kind: " <> Text.unpack kind
+                Data -> CT.Data
+                Ability -> CT.Effect
               conRef = V1Referent.ConstructorReference (V1Reference.Derived hash (unPgComponentIndex componentIndex)) (unPgConstructorIndex constructorIndex)
            in V1Referent.Con conRef dt
       )

share-api/src/Share/Postgres/Definitions/Types.hs

@@ -40,7 +40,7 @@ import U.Codebase.Sqlite.Term.Format qualified as TermFormat
 import Unison.ConstructorType qualified as CT
 
 -- | Type wrappers for keeping indexes straight
-newtype PgComponentIndex = PgComponentIndex Int64
+newtype PgComponentIndex = PgComponentIndex Int32
   deriving newtype (Show, Eq, Ord, EncodeValue, DecodeValue)
 
 pgComponentIndex :: Reference.Pos -> PgComponentIndex
@@ -49,7 +49,7 @@ pgComponentIndex = PgComponentIndex . fromIntegral
 unPgComponentIndex :: PgComponentIndex -> Reference.Pos
 unPgComponentIndex (PgComponentIndex i) = fromIntegral i
 
-newtype PgConstructorIndex = PgConstructorIndex Int64
+newtype PgConstructorIndex = PgConstructorIndex Int32
   deriving newtype (Show, Eq, Ord, EncodeValue, DecodeValue)
 
 pgConstructorIndex :: DD.ConstructorId -> PgConstructorIndex