@@ -0,0 +1,1808 @@
1+{-# LANGUAGE DuplicateRecordFields #-}
2+{-# LANGUAGE FunctionalDependencies #-}
3+{-# LANGUAGE NamedFieldPuns #-}
4+{-# LANGUAGE TemplateHaskell #-}
5+{-# LANGUAGE UndecidableInstances #-}
6+{-# OPTIONS_GHC -fno-warn-orphans #-}
7+
8+module Garnix.Types
9+ ( module Garnix.Types,
10+ module Garnix.Types.ExternalLenses,
11+ module Garnix.Types.Keys,
12+ )
13+where
14+
15+import Control.Lens
16+import Control.Lens.Regex.Text qualified as RE
17+import Control.Monad (mzero)
18+import Data.Aeson (defaultOptions, genericParseJSON, withObject)
19+import Data.Aeson qualified as Aeson
20+import Data.Aeson.Encode.Pretty (encodePretty)
21+import Data.Aeson.Encoding qualified as Aeson
22+import Data.Aeson.Key qualified as AesonKey
23+import Data.Aeson.KeyMap (toMapText)
24+import Data.Aeson.Types qualified as JSON
25+import Data.ByteString.Lazy qualified as BSL
26+import Data.Generics.Product (HasField' (..))
27+import Data.List.Extra (enumerate)
28+import Data.Map qualified as Map
29+import Data.Map.Strict qualified as StrictMap
30+import Data.Pool (Pool)
31+import Data.Text qualified as T
32+import Data.Text.Encoding (decodeUtf8)
33+import Database.PostgreSQL.Typed.Types (PGStringType)
34+import Garnix.Duration
35+import Garnix.Hosting.ServerPool.Types
36+import Garnix.MonetaryCost
37+import Garnix.Nix.Types qualified as Nix
38+import Garnix.Prelude
39+import Garnix.Types.ExternalLenses
40+import Garnix.Types.Keys
41+import GitHub.App.Auth (InstallationAuth)
42+import Network.HTTP.Types (Header, statusMessage)
43+import Network.Wreq qualified as Wreq
44+import Prettyprinter qualified as Pretty
45+import Servant qualified
46+import System.Log.FastLogger as FastLogger
47+import Prelude qualified
48+
49+-- * System
50+
51+data System
52+ = X8664Linux
53+ | X8664Darwin
54+ | AArch64Linux
55+ | AArch64Darwin
56+ | AArmV6LLinux
57+ | AArmV7LLinux
58+ | I686Linux
59+ | MIPSelLinux
60+ | OtherSystem Text
61+ deriving stock (Eq, Show, Generic, Ord)
62+
63+supportedSystems :: [System]
64+supportedSystems = [X8664Linux, AArch64Darwin, AArch64Linux, X8664Darwin, I686Linux]
65+
66+systemTextIso :: Iso' System Text
67+systemTextIso = iso from' to'
68+ where
69+ from' x = case x of
70+ X8664Linux -> "x86_64-linux"
71+ X8664Darwin -> "x86_64-darwin"
72+ AArch64Linux -> "aarch64-linux"
73+ AArch64Darwin -> "aarch64-darwin"
74+ AArmV6LLinux -> "armv6l-linux"
75+ AArmV7LLinux -> "armv7l-linux"
76+ I686Linux -> "i686-linux"
77+ MIPSelLinux -> "mipsel-linux"
78+ OtherSystem s -> s
79+ to' x = case x of
80+ "x86_64-linux" -> X8664Linux
81+ "x86_64-darwin" -> X8664Darwin
82+ "aarch64-linux" -> AArch64Linux
83+ "aarch64-darwin" -> AArch64Darwin
84+ "armv6l-linux" -> AArmV6LLinux
85+ "armv7l-linux" -> AArmV7LLinux
86+ "i686-linux" -> I686Linux
87+ "mipsel-linux" -> MIPSelLinux
88+ _ -> OtherSystem x
89+
90+instance Pretty System where
91+ pretty x = pretty $ x ^. systemTextIso
92+
93+instance ToJSON System where
94+ toJSON x = Aeson.String $ x ^. systemTextIso
95+
96+instance FromJSON System where
97+ parseJSON = Aeson.withText "system" $ \t -> pure $ t ^. from systemTextIso
98+
99+instance ToJSONKey System where
100+ toJSONKey = contramap (^. systemTextIso) Aeson.toJSONKey
101+
102+instance FromJSONKey System where
103+ fromJSONKey = fmap (^. from systemTextIso) Aeson.fromJSONKey
104+
105+-- | This is a 'Maybe System', but we use a special datatype because it
106+-- is not encoded as NULL in the DB (since it's part of the primary key), but
107+-- as 'noSystem'.
108+--
109+-- It is 'noSystem' for 'buildStarting'.
110+data MaybeSystem = IsSystem System | NoSystem
111+ deriving stock (Eq, Show, Ord, Generic)
112+
113+instance Pretty MaybeSystem where
114+ pretty = \case
115+ IsSystem s -> pretty s
116+ NoSystem -> "none"
117+
118+maybeSystemIso :: Iso' MaybeSystem (Maybe System)
119+maybeSystemIso = iso from' to'
120+ where
121+ from' x = case x of
122+ NoSystem -> Nothing
123+ IsSystem s -> Just s
124+ to' x = case x of
125+ Nothing -> NoSystem
126+ Just s -> IsSystem s
127+
128+instance ToJSON MaybeSystem where
129+ toJSON x = Aeson.toJSON $ x ^. maybeSystemIso
130+
131+instance FromJSON MaybeSystem where
132+ parseJSON x = (^. from maybeSystemIso) <$> Aeson.parseJSON x
133+
134+instance Servant.FromHttpApiData MaybeSystem where
135+ parseUrlPiece piece = case piece of
136+ "noSystem" -> pure NoSystem
137+ _ -> pure $ IsSystem $ piece ^. from systemTextIso
138+
139+instance PGType "system" where
140+ type PGVal "system" = MaybeSystem
141+
142+instance PGParameter "system" MaybeSystem where
143+ pgEncode _ msys = case msys of
144+ NoSystem -> "noSystem"
145+ IsSystem sys -> sys ^. systemTextIso . to cs
146+
147+instance PGColumn "system" MaybeSystem where
148+ pgDecode _ msys = case msys of
149+ "noSystem" -> NoSystem
150+ sys -> IsSystem $ sys ^. to cs . from systemTextIso
151+
152+instance PGType "citext" where
153+ type PGVal "citext" = Text
154+
155+instance PGStringType "citext"
156+
157+-- * Packages
158+
159+data SystemPackage = SystemPackage
160+ { systemPackageSystem :: System,
161+ systemPackagePackage :: Package
162+ }
163+ deriving stock (Eq, Show, Generic)
164+
165+newtype Package = Package {_packageName :: Text}
166+ deriving stock (Eq, Show, Generic)
167+
168+instance ToJSON Package where
169+ toEncoding = ourToEncoding
170+ toJSON = ourToJSON
171+
172+instance FromJSON Package where parseJSON = ourParseJSON
173+
174+newtype PackageName = PackageName {getPackageName :: Text}
175+ deriving stock (Eq, Show, Ord, Generic)
176+ deriving newtype
177+ ( ToJSON,
178+ FromJSON,
179+ ToJSONKey,
180+ FromJSONKey,
181+ Servant.FromHttpApiData,
182+ Servant.ToHttpApiData,
183+ PGParameter "character varying",
184+ PGParameter "text",
185+ PGColumn "character varying",
186+ PGColumn "text",
187+ Pretty,
188+ IsString
189+ )
190+
191+instance ConvertibleStrings Text PackageName where
192+ convertString = PackageName
193+
194+instance ConvertibleStrings PackageName Text where
195+ convertString = getPackageName
196+
197+instance Inject Text PackageName where inj = cs
198+
199+instance Project Text PackageName where prj = cs
200+
201+instance Isomorphic Text PackageName
202+
203+data PackageType
204+ = TypePackage
205+ | TypeCheck
206+ | TypeHomeConfiguration
207+ | TypeDarwinConfiguration
208+ | TypeNixosConfiguration
209+ | TypeDevShell
210+ | TypeDefaultDevShell
211+ | TypeDefaultPackage
212+ | TypeApp
213+ | TypeOverall
214+ deriving stock (Eq, Show, Enum, Bounded, Ord, Generic)
215+
216+instance PGType "package_type" where
217+ type PGVal "package_type" = PackageType
218+
219+asPackageType :: Prism' Text PackageType
220+asPackageType = prism there back
221+ where
222+ there i = case lookup i asPackageTypePairs of
223+ Just x -> x
224+ Nothing -> error $ "missing pattern: " <> show i
225+ back i = case lookup i (swap <$> asPackageTypePairs) of
226+ Just x -> Right x
227+ Nothing -> Left i
228+
229+asPackageTypePairs :: [(PackageType, Text)]
230+asPackageTypePairs = annotate <$> enumerate @PackageType
231+ where
232+ annotate :: PackageType -> (PackageType, Text)
233+ annotate = \case
234+ TypePackage -> (TypePackage, "package")
235+ TypeCheck -> (TypeCheck, "check")
236+ TypeHomeConfiguration -> (TypeHomeConfiguration, "homeConfiguration")
237+ TypeDarwinConfiguration -> (TypeDarwinConfiguration, "darwinConfiguration")
238+ TypeNixosConfiguration -> (TypeNixosConfiguration, "nixosConfiguration")
239+ TypeDevShell -> (TypeDevShell, "devShell")
240+ TypeDefaultDevShell -> (TypeDefaultDevShell, "defaultDevShell")
241+ TypeDefaultPackage -> (TypeDefaultPackage, "defaultPackage")
242+ TypeApp -> (TypeApp, "app")
243+ TypeOverall -> (TypeOverall, "overall")
244+
245+instance PGParameter "package_type" PackageType where
246+ pgEncode _ status = cs $ review asPackageType status
247+
248+instance PGColumn "package_type" PackageType where
249+ pgDecode _ status = case cs status ^? asPackageType of
250+ Just p -> p
251+ Nothing ->
252+ error
253+ $ "Expected one of: "
254+ <> show (snd <$> asPackageTypePairs)
255+ <> ", got: "
256+ <> cs status
257+
258+instance Servant.FromHttpApiData PackageType where
259+ parseUrlPiece piece = case piece ^? asPackageType of
260+ Just p -> Right p
261+ Nothing ->
262+ Left
263+ $ "Expected one of: "
264+ <> show (snd <$> asPackageTypePairs)
265+ <> ", got: "
266+ <> cs piece
267+
268+instance Pretty PackageType where
269+ pretty = pretty . review asPackageType
270+
271+instance ToJSON PackageType where
272+ toJSON = Aeson.toJSON . review asPackageType
273+
274+instance FromJSON PackageType where
275+ parseJSON = Aeson.withText "PackageType" $ \pt -> case pt ^? asPackageType of
276+ Just p -> pure p
277+ Nothing ->
278+ fail
279+ . cs
280+ $ "Expected one of: "
281+ <> show (snd <$> asPackageTypePairs)
282+ <> ", got: "
283+ <> cs pt
284+
285+-- | A fake package for reporting basic results such as whether the flake.nix
286+-- can be parsed.
287+buildStarting :: PackageName
288+buildStarting = PackageName "Build starting"
289+
290+newtype Packages a = Packages {getPackages :: Map.Map System (Map.Map PackageName a)}
291+ deriving stock (Eq, Show, Generic, Functor, Foldable, Traversable)
292+ deriving newtype (Semigroup, Monoid, ToJSON, FromJSON)
293+
294+data GhRun = GhRun
295+ { _ghRunName :: Text,
296+ _ghRunHeadSha :: CommitHash,
297+ _ghRunStatus :: Text,
298+ _ghRunOutput :: Maybe RunOutput,
299+ _ghRunDetailsUrl :: Maybe Text,
300+ _ghRunConclusion :: Maybe Text
301+ }
302+ deriving stock (Eq, Ord, Show, Generic)
303+
304+instance ToJSON GhRun where
305+ toEncoding = ourToEncoding
306+ toJSON = ourToJSON
307+
308+instance FromJSON GhRun where parseJSON = ourParseJSON
309+
310+data RunOutput = RunOutput
311+ { _runOutputTitle :: Text,
312+ _runOutputSummary :: Text,
313+ _runOutputText :: Text
314+ }
315+ deriving stock (Eq, Ord, Show, Generic)
316+
317+instance ToJSON RunOutput where
318+ toEncoding = ourToEncoding
319+ toJSON = ourToJSON
320+
321+instance FromJSON RunOutput where parseJSON = ourParseJSON
322+
323+-- * Repo
324+
325+data Repo = Repo
326+ { _repoReqUser :: UserId,
327+ _repoRepoUser :: GhRepoOwner,
328+ _repoRepoName :: GhRepoName,
329+ _repoEnabledAt :: UTCTime
330+ }
331+ deriving stock (Eq, Show, Generic)
332+
333+instance ToJSON Repo where
334+ toEncoding = ourToEncoding
335+ toJSON = ourToJSON
336+
337+instance FromJSON Repo where parseJSON = ourParseJSON
338+
339+data UserOverviewRepo = UserOverviewRepo
340+ { _userOverviewRepoRepoUser :: GhRepoOwner,
341+ _userOverviewRepoRepoName :: GhRepoName,
342+ _userOverviewRepoEnabled :: Bool
343+ }
344+ deriving stock (Eq, Show, Generic)
345+
346+instance ToJSON UserOverviewRepo where
347+ toEncoding = ourToEncoding
348+ toJSON = ourToJSON
349+
350+instance FromJSON UserOverviewRepo where parseJSON = ourParseJSON
351+
352+-- * Build
353+
354+newtype BuildId = BuildId {getBuildId :: HashId}
355+ deriving stock (Eq, Show, Generic)
356+ deriving newtype
357+ ( ToJSON,
358+ FromJSON,
359+ FromHttpApiData,
360+ ToHttpApiData,
361+ Pretty,
362+ PGColumn "bigint",
363+ PGParameter "bigint"
364+ )
365+
366+newtype RepoPublicity = RepoIsPublic {isRepoPublic :: Bool}
367+ deriving stock (Eq, Show, Generic)
368+ deriving newtype
369+ ( ToJSON,
370+ FromJSON,
371+ FromHttpApiData,
372+ ToHttpApiData,
373+ Pretty,
374+ PGColumn "boolean",
375+ PGParameter "boolean"
376+ )
377+
378+newtype BuildStreamId = BuildStreamId {getBuildStreamId :: HashId}
379+ deriving stock (Eq, Show, Generic)
380+ deriving newtype
381+ ( ToJSON,
382+ FromJSON,
383+ FromHttpApiData,
384+ ToHttpApiData,
385+ Pretty,
386+ PGColumn "bigint",
387+ PGParameter "bigint"
388+ )
389+
390+newtype BuildOutputsPgColumn = BuildOutputsPgColumn {buildOutputs :: Nix.BuildOutputs}
391+ deriving stock (Eq, Show, Generic)
392+
393+instance PGColumn "json" BuildOutputsPgColumn where
394+ pgDecode PGTypeProxy = fromMaybe (error "Failed to deserialize PGColumn BuildOutputsPgColumn") . Aeson.decodeStrict'
395+
396+instance PGParameter "json" BuildOutputsPgColumn where
397+ pgEncode PGTypeProxy = cs . Aeson.encode
398+
399+instance FromJSON BuildOutputsPgColumn where
400+ parseJSON = withObject "build outputs pg column" $ \o -> do
401+ outputs <- forM o $ \v -> do
402+ text :: Text <- parseJSON v
403+ case Nix.parseStorePath text of
404+ Left err -> JSON.parseFail $ cs err
405+ Right path -> pure path
406+ pure $ BuildOutputsPgColumn $ Nix.BuildOutputs $ toMapText outputs
407+
408+instance ToJSON BuildOutputsPgColumn where
409+ toJSON (BuildOutputsPgColumn (Nix.BuildOutputs map)) = toJSON $ Nix.getStorePath <$> map
410+
411+outputsForBuild :: Build -> Maybe Nix.BuildOutputs
412+outputsForBuild build = buildOutputs <$> _buildOutputPaths build
413+
414+data Build = Build
415+ { _buildId :: BuildId,
416+ _buildRepoUser :: GhRepoOwner,
417+ _buildRepoName :: GhRepoName,
418+ _buildPrFromFork :: Maybe PrFromFork,
419+ _buildBranch :: Maybe Branch,
420+ _buildRepoIsPublic :: RepoPublicity,
421+ _buildGitCommit :: CommitHash,
422+ _buildPackage :: PackageName,
423+ _buildPackageType :: PackageType,
424+ _buildSystem :: MaybeSystem,
425+ _buildReqUser :: GhLogin,
426+ _buildStatus :: Maybe Status,
427+ _buildStartTime :: UTCTime,
428+ _buildEndTime :: Maybe UTCTime,
429+ _buildDrvPath :: Maybe FilePath,
430+ _buildOutputPaths :: Maybe BuildOutputsPgColumn,
431+ _buildGithubRunId :: Maybe GhRunId,
432+ _buildPersistenceName :: Maybe Text,
433+ _buildWantsIncrementalism :: Bool,
434+ _buildEvalHost :: Maybe Text,
435+ _buildUploadedToCache :: Maybe Bool,
436+ _buildAlreadyBuilt :: Maybe Bool
437+ }
438+ deriving stock (Eq, Show, Generic)
439+
440+instance ToJSON Build where
441+ toEncoding = ourToEncoding
442+ toJSON = ourToJSON
443+
444+instance FromJSON Build where parseJSON = ourParseJSON
445+
446+instance Pretty Build where
447+ pretty s =
448+ "build:"
449+ <+> Pretty.line
450+ <+> Pretty.nest
451+ 2
452+ ( vsep
453+ [ "id:" <> pretty (_buildId s),
454+ "repoUser:" <+> pretty (_buildRepoUser s),
455+ "repoName:" <+> pretty (_buildRepoName s),
456+ "prFromFork:" <+> pretty (_buildPrFromFork s),
457+ "repoIsPublic:" <+> pretty (_buildRepoIsPublic s),
458+ "gitCommit:" <+> pretty (_buildGitCommit s),
459+ "package:" <+> pretty (_buildPackage s),
460+ "packageType:" <+> pretty (_buildPackageType s),
461+ "system:" <+> pretty (_buildSystem s),
462+ "reqUser:" <+> pretty (_buildReqUser s),
463+ "status:" <+> pretty (_buildStatus s),
464+ "startTime:" <+> pretty (show $ _buildStartTime s),
465+ "endTime:" <+> pretty (show $ _buildEndTime s),
466+ "drvPath:" <+> pretty (_buildDrvPath s),
467+ "githubRunId:" <+> pretty (_buildGithubRunId s)
468+ ]
469+ )
470+
471+buildComment :: Build -> Text
472+buildComment build =
473+ show (pretty (_buildId build))
474+ <> "_"
475+ <> show (pretty (_buildRepoUser build))
476+ <> "/"
477+ <> show (pretty (_buildRepoName build))
478+ <> "/"
479+ <> show (pretty (_buildBranch build))
480+
481+newtype LockedFile = LockedFile {getLockedFile :: FilePath}
482+
483+-- | Logs as nix gives us (prior to any filtering or processing)
484+newtype RawLogs = RawLogs {getRawLogs :: Text}
485+ deriving stock (Eq, Show, Generic)
486+ deriving newtype (IsString, Pretty, ConvertibleStrings String)
487+
488+data BuildResponse = BuildResponse
489+ { _buildResponseId :: BuildId,
490+ _buildResponseRepoUser :: GhRepoOwner,
491+ _buildResponseRepoName :: GhRepoName,
492+ _buildResponseGitCommit :: CommitHash,
493+ _buildResponsePackage :: PackageName,
494+ _buildResponsePackageType :: PackageType,
495+ _buildResponseSystem :: MaybeSystem,
496+ _buildResponseReqUser :: GhLogin,
497+ _buildResponseBranch :: Maybe Branch,
498+ _buildResponseStatus :: Maybe Status,
499+ _buildResponseStartTime :: UTCTime,
500+ _buildResponseEndTime :: Maybe UTCTime,
501+ _buildResponseGithubRunId :: Maybe GhRunId,
502+ _buildResponseOriginalBuild :: Maybe OriginalBuild,
503+ _buildResponseRelatedBuilds :: [OriginalBuild] -- deprecated
504+ }
505+ deriving (Eq, Show, Generic)
506+
507+instance ToJSON BuildResponse where
508+ toEncoding = ourToEncoding
509+ toJSON = ourToJSON
510+
511+instance FromJSON BuildResponse where parseJSON = ourParseJSON
512+
513+data OriginalBuild = OriginalBuild
514+ { _originalBuildId :: BuildId,
515+ _originalBuildGitCommit :: CommitHash,
516+ _originalBuildStatus :: Maybe Status
517+ }
518+ deriving (Eq, Show, Generic)
519+
520+instance ToJSON OriginalBuild where
521+ toEncoding = ourToEncoding
522+ toJSON = ourToJSON
523+
524+instance FromJSON OriginalBuild where parseJSON = ourParseJSON
525+
526+data BuildUpdate = BuildUpdate
527+ { _buildUpdateStatus :: Maybe Status
528+ }
529+ deriving (Eq, Show, Generic)
530+
531+instance ToJSON BuildUpdate where
532+ toEncoding = ourToEncoding
533+ toJSON = ourToJSON
534+
535+instance FromJSON BuildUpdate where parseJSON = ourParseJSON
536+
537+-- * Project
538+
539+data Status = Success | Failure | Timeout | Cancelled
540+ deriving stock (Eq, Ord, Show, Generic, Bounded, Enum)
541+ deriving anyclass (ToJSON, FromJSON)
542+
543+instance Pretty Status where
544+ pretty = \case
545+ Success -> "success"
546+ Failure -> "failure"
547+ Timeout -> "timeout"
548+ Cancelled -> "cancelled"
549+
550+instance PGType "build_status" where
551+ type PGVal "build_status" = Status
552+
553+instance PGParameter "build_status" Status where
554+ pgEncode _ status = case status of
555+ Success -> "success"
556+ Failure -> "failure"
557+ Timeout -> "timeout"
558+ Cancelled -> "cancelled"
559+
560+instance PGColumn "build_status" Status where
561+ pgDecode _ status = case status of
562+ "success" -> Success
563+ "failure" -> Failure
564+ "timeout" -> Timeout
565+ "cancelled" -> Cancelled
566+ e -> error $ "Impossible: expected 'success', 'failure', 'timeout' or 'cancelled', got: " <> cs e
567+
568+newtype Logs = Logs {getLogs :: Text}
569+ deriving stock (Eq, Show, Generic)
570+ deriving newtype (ToJSON, FromJSON)
571+
572+data SingleRunResult = SingleRunResult
573+ { _singleRunResultStatus :: Status,
574+ _singleRunResultLogs :: Maybe Logs
575+ }
576+ deriving stock (Eq, Show, Generic)
577+
578+instance ToJSON SingleRunResult where
579+ toEncoding = ourToEncoding
580+ toJSON = ourToJSON
581+
582+instance FromJSON SingleRunResult where parseJSON = ourParseJSON
583+
584+data RunResult = RunResult
585+ { _runResultStatus :: Status,
586+ _runResultPackages :: Map.Map System (Map.Map PackageName (Maybe SingleRunResult))
587+ }
588+ deriving stock (Eq, Show, Generic)
589+
590+instance ToJSON RunResult where
591+ toEncoding = ourToEncoding
592+ toJSON = ourToJSON
593+
594+instance FromJSON RunResult where parseJSON = ourParseJSON
595+
596+-- * Commit
597+
598+data CommitStatus = Evaluating | Evaluated
599+ deriving stock (Eq, Show, Enum, Bounded, Ord, Generic)
600+
601+instance PGType "commit_status" where
602+ type PGVal "commit_status" = CommitStatus
603+
604+asCommitStatus :: Prism' Text CommitStatus
605+asCommitStatus = prism there back
606+ where
607+ there i = case lookup i asCommitStatusPairs of
608+ Just x -> x
609+ Nothing -> error $ "missing pattern: " <> show i
610+ back i = case lookup i (swap <$> asCommitStatusPairs) of
611+ Just x -> Right x
612+ Nothing -> Left i
613+
614+asCommitStatusPairs :: [(CommitStatus, Text)]
615+asCommitStatusPairs =
616+ [ (Evaluating, "evaluating"),
617+ (Evaluated, "evaluated")
618+ ]
619+
620+instance PGParameter "commit_status" CommitStatus where
621+ pgEncode _ status = cs $ review asCommitStatus status
622+
623+instance PGColumn "commit_status" CommitStatus where
624+ pgDecode _ status = case cs status ^? asCommitStatus of
625+ Just p -> p
626+ Nothing ->
627+ error
628+ $ "Expected one of: "
629+ <> show (snd <$> asCommitStatusPairs)
630+ <> ", got: "
631+ <> cs status
632+
633+instance Pretty CommitStatus where
634+ pretty = pretty . review asCommitStatus
635+
636+data CheckStatus = CheckPending | CheckFail | CheckSuccess
637+ deriving stock (Eq, Show, Enum, Bounded, Ord, Generic)
638+
639+instance PGType "check_status" where
640+ type PGVal "check_status" = CheckStatus
641+
642+asCheckStatus :: Prism' Text CheckStatus
643+asCheckStatus = prism there back
644+ where
645+ there i = case lookup i asCheckStatusPairs of
646+ Just x -> x
647+ Nothing -> error $ "missing pattern: " <> show i
648+ back i = case lookup i (swap <$> asCheckStatusPairs) of
649+ Just x -> Right x
650+ Nothing -> Left i
651+
652+asCheckStatusPairs :: [(CheckStatus, Text)]
653+asCheckStatusPairs =
654+ [ (CheckPending, "pending"),
655+ (CheckFail, "fail"),
656+ (CheckSuccess, "success")
657+ ]
658+
659+instance PGParameter "check_status" CheckStatus where
660+ pgEncode _ status = cs $ review asCheckStatus status
661+
662+instance PGColumn "check_status" CheckStatus where
663+ pgDecode _ status = case cs status ^? asCheckStatus of
664+ Just p -> p
665+ Nothing ->
666+ error
667+ $ "Expected one of: "
668+ <> show (snd <$> asCheckStatusPairs)
669+ <> ", got: "
670+ <> cs status
671+
672+instance Pretty CheckStatus where
673+ pretty = pretty . review asCheckStatus
674+
675+data Commit = Commit
676+ { _commitRepoOwner :: GhRepoOwner,
677+ _commitRepoName :: GhRepoName,
678+ _commitHash :: CommitHash,
679+ _commitStatus :: CommitStatus,
680+ _commitMetaCheck :: CheckStatus
681+ }
682+ deriving stock (Eq, Show, Generic)
683+
684+data FullCommitState
685+ = CommitEvaluating
686+ | CommitEvaluated Commit [Build] [Run]
687+ deriving stock (Eq, Show, Generic)
688+
689+data Run = Run
690+ { _runId :: RunId,
691+ _runName :: Text,
692+ _runRepoUser :: GhRepoOwner,
693+ _runRepoName :: GhRepoName,
694+ _runGitCommit :: CommitHash,
695+ _runBranch :: Maybe Branch,
696+ _runStatus :: Maybe Status,
697+ _runReqUser :: GhLogin,
698+ _runStartTime :: UTCTime,
699+ _runEndTime :: Maybe UTCTime
700+ }
701+ deriving stock (Eq, Show, Generic)
702+
703+newtype RunId = RunId {getRunId :: HashId}
704+ deriving stock (Eq, Show, Generic)
705+ deriving newtype
706+ ( PGColumn "bigint",
707+ PGParameter "bigint",
708+ FromHttpApiData
709+ )
710+
711+-- * User
712+
713+--
714+newtype RequestingGhLogin = RequestingGhLogin {getRequestingGhLogin :: GhLogin}
715+ deriving stock (Eq, Show, Generic)
716+ deriving newtype
717+ ( ToJSON,
718+ FromJSON,
719+ PGParameter "character varying",
720+ PGParameter "text",
721+ PGColumn "character varying",
722+ PGColumn "text",
723+ IsString
724+ )
725+
726+newtype GhRepoOwner = GhRepoOwner {getGhRepoOwner :: GhLogin}
727+ deriving stock (Eq, Show, Generic)
728+ deriving newtype
729+ ( ToJSON,
730+ FromJSON,
731+ ToJSONKey,
732+ Ord,
733+ Servant.FromHttpApiData,
734+ Servant.ToHttpApiData,
735+ PGParameter "character varying",
736+ PGParameter "text",
737+ PGColumn "character varying",
738+ PGColumn "text",
739+ Pretty,
740+ IsString
741+ )
742+
743+newtype GhLogin = GhLogin {getGhLogin :: Text}
744+ deriving stock (Eq, Show, Generic)
745+ deriving newtype
746+ ( ToJSON,
747+ FromJSON,
748+ ToJSONKey,
749+ Ord,
750+ Servant.FromHttpApiData,
751+ Servant.ToHttpApiData,
752+ PGParameter "character varying",
753+ PGParameter "text",
754+ PGColumn "character varying",
755+ PGColumn "text",
756+ Pretty,
757+ IsString
758+ )
759+
760+newtype GhRepoName = GhRepoName {getGhRepoName :: Text}
761+ deriving stock (Eq, Show, Generic)
762+ deriving newtype
763+ ( ToJSON,
764+ FromJSON,
765+ Ord,
766+ Servant.FromHttpApiData,
767+ Servant.ToHttpApiData,
768+ PGParameter "character varying",
769+ PGParameter "text",
770+ PGColumn "character varying",
771+ PGColumn "text",
772+ Pretty,
773+ IsString
774+ )
775+
776+newtype InternalCacheToken = InternalCacheToken {getInternalCacheToken :: Text}
777+ deriving stock (Eq, Show, Generic)
778+
779+generateInternalCacheToken :: (MonadIO m) => m InternalCacheToken
780+generateInternalCacheToken = InternalCacheToken <$> randomBase64 64
781+
782+newtype NetRcFile = NetRcFile {getNetRcFile :: FilePath}
783+ deriving stock (Show)
784+
785+newtype NixConfig = NixConfig {getNixConfig :: StrictMap.Map String String}
786+ deriving stock (Show)
787+
788+instance Semigroup NixConfig where
789+ NixConfig left <> NixConfig right = NixConfig $ left <> right
790+
791+newtype PrFromFork = PrFromFork {getPrFromForkFullName :: Text}
792+ deriving stock (Eq, Show, Generic)
793+ deriving newtype
794+ ( ToJSON,
795+ FromJSON,
796+ Ord,
797+ Servant.FromHttpApiData,
798+ Servant.ToHttpApiData,
799+ PGParameter "character varying",
800+ PGParameter "text",
801+ PGColumn "character varying",
802+ PGColumn "text",
803+ Pretty,
804+ IsString
805+ )
806+
807+newtype Email = Email {getEmail :: Text}
808+ deriving stock (Eq, Ord, Show, Generic)
809+ deriving newtype
810+ ( ToJSON,
811+ FromJSON,
812+ PGParameter "character varying",
813+ PGParameter "text",
814+ PGColumn "character varying",
815+ PGColumn "text",
816+ Pretty,
817+ IsString
818+ )
819+
820+newtype CommitHash = CommitHash {getCommitHash :: Text}
821+ deriving stock (Eq, Show, Ord, Generic)
822+ deriving newtype
823+ ( ToJSON,
824+ FromJSON,
825+ Servant.FromHttpApiData,
826+ Servant.ToHttpApiData,
827+ PGParameter "character varying",
828+ PGParameter "text",
829+ PGColumn "character varying",
830+ PGColumn "text",
831+ Pretty,
832+ IsString
833+ )
834+
835+instance Inject Text CommitHash where
836+ inj = CommitHash
837+
838+instance Project Text CommitHash where
839+ prj = getCommitHash
840+
841+instance Isomorphic Text CommitHash
842+
843+newtype Branch = Branch {getBranch :: Text}
844+ deriving stock (Eq, Show, Ord, Generic)
845+ deriving newtype
846+ ( ToJSON,
847+ FromJSON,
848+ Servant.FromHttpApiData,
849+ Servant.ToHttpApiData,
850+ PGParameter "character varying",
851+ PGParameter "text",
852+ PGColumn "character varying",
853+ PGColumn "text",
854+ Pretty,
855+ IsString
856+ )
857+
858+instance ConvertibleStrings Text Branch where
859+ convertString = Branch
860+
861+instance ConvertibleStrings Branch Text where
862+ convertString = getBranch
863+
864+instance Inject Text Branch where inj = cs
865+
866+instance Project Text Branch where prj = cs
867+
868+instance Isomorphic Text Branch
869+
870+newtype GhPullRequestId = GhPullRequestId {getGhPullRequestId :: Int64}
871+ deriving stock (Eq, Show)
872+ deriving newtype
873+ ( Num,
874+ ToJSON,
875+ FromJSON,
876+ PGParameter "bigint",
877+ PGColumn "bigint"
878+ )
879+
880+instance (Inject a b, Functor f) => Inject (f a) (f b) where
881+ inj = fmap inj
882+
883+instance (Project a b, Functor f) => Project (f a) (f b) where
884+ prj = fmap prj
885+
886+instance (Inject a b, Project a b, Functor f) => Isomorphic (f a) (f b)
887+
888+newtype GhToken = GhToken {getGhToken :: Text}
889+ deriving stock (Eq, Show, Generic)
890+ deriving newtype (ToJSON, FromJSON, Servant.FromHttpApiData, Servant.ToHttpApiData)
891+
892+obfuscateGithubToken :: Text -> Text
893+obfuscateGithubToken =
894+ [RE.regex|gh[pousr]_\w{15,255}|] . RE.match .~ "XXXXXXXXXXXXXXXX"
895+
896+data CommitSummary = CommitSummary
897+ { _commitSummaryRepoOwner :: GhRepoOwner,
898+ _commitSummaryRepoName :: GhRepoName,
899+ _commitSummaryRepoIsPublic :: RepoPublicity,
900+ _commitSummaryGitCommit :: CommitHash,
901+ _commitSummaryBranch :: Maybe Branch,
902+ _commitSummaryReqUser :: GhLogin,
903+ _commitSummaryStartTime :: UTCTime,
904+ _commitSummarySucceeded :: Int64,
905+ _commitSummaryFailed :: Int64,
906+ _commitSummaryPending :: Int64,
907+ _commitSummaryCancelled :: Int64
908+ }
909+ deriving (Eq, Show, Generic)
910+
911+instance ToJSON CommitSummary where
912+ toEncoding = ourToEncoding
913+ toJSON = ourToJSON
914+
915+-- * Errors
916+
917+data ErrorWithContext = ErrorWithContext
918+ { callstack :: CallStack,
919+ spans :: [(Text, Text)],
920+ severity :: Severity,
921+ err :: Error
922+ }
923+ deriving stock (Show, Generic)
924+
925+errLens :: Lens' ErrorWithContext Error
926+errLens = lens err (\error err -> error {err})
927+
928+instance Eq ErrorWithContext where
929+ e1 == e2 = err e1 == err e2
930+
931+instance ToJSON ErrorWithContext where
932+ toJSON = Aeson.toJSON . err
933+
934+showDebug :: ErrorWithContext -> Text
935+showDebug e =
936+ message <> "\n\n" <> cs (prettyCallStack $ callstack e)
937+ where
938+ message = case err e of
939+ OtherError message -> "OtherError: " <> message
940+ inner -> showPretty inner
941+
942+data SubdomainKind
943+ = RepoOwnerSubdomain
944+ | RepoNameSubdomain
945+ | BranchSubdomain
946+ | PackageNameSubdomain
947+ | PersistenceNameSubdomain
948+ deriving stock (Eq, Show, Generic)
949+
950+instance Pretty SubdomainKind where
951+ pretty =
952+ \case
953+ RepoOwnerSubdomain -> "repo owner"
954+ RepoNameSubdomain -> "repo name"
955+ BranchSubdomain -> "branch"
956+ PackageNameSubdomain -> "package name"
957+ PersistenceNameSubdomain -> "persistence name"
958+
959+data Error
960+ = UncaughtRuntimeException {message :: Text}
961+ | RunProcessError
962+ { command :: Text,
963+ arguments :: [Text],
964+ stdErr :: Text,
965+ stdOut :: Text,
966+ exitCode :: Int
967+ }
968+ | DecodeError {original :: Text, message :: Text}
969+ | NoSuchBuild {buildId :: BuildId}
970+ | NoSuchBuildRunId {ghRunId :: GhRunId}
971+ | NoSuchRun {runId :: RunId}
972+ | NoSuchCommit CommitHash
973+ | NoSuchRepo {_owner :: GhRepoOwner, _name :: GhRepoName}
974+ | NoSuchUser GhLogin
975+ | ErrorGettingBuildPlan {message :: Text}
976+ | ErrorGettingAttributesToBuild {message :: Text}
977+ | IsDeniedAccess
978+ | DuplicateBuild
979+ | UserAlreadyExists GhLogin
980+ | DbError {statement :: Text, message :: Text}
981+ | ProvisioningError {message :: Text}
982+ | ActivationError {serverInfo :: ServerInfo, stdErr :: Text}
983+ | GithubDidntGiveUsAToken
984+ | RedirectFound {location :: Text}
985+ | BadRequest {message :: Text}
986+ | Unauthorized
987+ | UnauthorizedWithMessage {message :: Text}
988+ | Forbidden
989+ | ForbiddenWithMessage {message :: Text}
990+ | NotFound
991+ | OtherError Text
992+ | DecodeConfigError {message :: Text}
993+ | SshTimeout {command :: Text}
994+ | InvalidEmail
995+ | InvalidAccessToken
996+ | EntitlementError {message :: Text}
997+ | DevModeOnly
998+ | DeploymentWantsNixosConfigurationsThatDontExist [PackageName]
999+ | NameIsNotValidSubdomain SubdomainKind Text
1000+ | TransactionAlreadyStarted
1001+ | BuildAlreadyStopped {buildId :: BuildId}
1002+ | InvalidBuildUpdate {buildUpdateBody :: BuildUpdate}
1003+ | FailedToParseDrvFile {drvFile :: FilePath, message :: Text}
1004+ | CachedError {inner :: ErrorWithContext}
1005+ | GarnixAppUnauthorized GhRepoOwner GhRepoName
1006+ | GithubRequestTimeout
1007+ | FailedToParseCreateReportResult Aeson.Value
1008+ | ModuleErrorFlakeExists
1009+ | ActionExecutionTimeout
1010+ | ActionPreconditionNixStore Text
1011+ | ActionPreconditionFileExists {sandboxTypeStr :: Text}
1012+ | ActionSandboxTypeNotAllowed Text
1013+ | ActionKeyDecryptionFailure
1014+ | ActionEvaluationFailure Text
1015+ deriving stock (Eq, Show, Generic)
1016+
1017+instance Pretty Error where
1018+ pretty x = case x of
1019+ UncaughtRuntimeException {message} -> "runtime exception:" <+> pretty message
1020+ NoSuchUser user ->
1021+ "No user with github login"
1022+ <+> pretty (getGhLogin user)
1023+ <+> "could be found"
1024+ NoSuchBuild {} ->
1025+ "No build matching that description could be found."
1026+ <+> "Either it doesn't exist, or you don't have access to it."
1027+ NoSuchBuildRunId {..} ->
1028+ "No build with github run id"
1029+ <+> pretty ghRunId
1030+ <+> "found."
1031+ <+> "Either it doesn't exist, or you don't have access to it."
1032+ NoSuchRun {} ->
1033+ "No run matching that description could be found."
1034+ <+> "Either it doesn't exist, or you don't have access to it."
1035+ NoSuchCommit commit ->
1036+ "Commit"
1037+ <+> pretty commit
1038+ <+> "not found."
1039+ <+> "Either it doesn't exist, or you don't have access to it."
1040+ NoSuchRepo {..} ->
1041+ "The repo https://github.com/"
1042+ <> pretty (getGhLogin (getGhRepoOwner _owner))
1043+ <> "/"
1044+ <> pretty (getGhRepoName _name)
1045+ <> " doesn't exist, has not enabled garnix, or you don't have access to it."
1046+ IsDeniedAccess ->
1047+ "This request has been denied. Anomalous activity detected. Please contact contact@garnix.io for more information."
1048+ UserAlreadyExists user ->
1049+ "User with github login"
1050+ <+> pretty (getGhLogin user)
1051+ <+> "already exists"
1052+ GithubDidntGiveUsAToken -> "Github didn't give us a user token"
1053+ DecodeError {..} ->
1054+ "Error decoding ("
1055+ <> pretty message
1056+ <> "):"
1057+ <+> pretty (limitMessage original)
1058+ where
1059+ limit = 10000
1060+ limitMessage text =
1061+ if T.length text > limit
1062+ then T.take limit text <> "[...snip]"
1063+ else text
1064+ DuplicateBuild -> "Build already exists"
1065+ RedirectFound {location} -> "Redirect error to " <> pretty location
1066+ BadRequest {message} -> "Bad Request: " <> pretty message
1067+ Unauthorized -> "You need to login to continue"
1068+ UnauthorizedWithMessage {message} -> "Unauthorized: " <> pretty message
1069+ Forbidden -> "You are not authorized for this resource"
1070+ ForbiddenWithMessage {message} -> "Forbidden: " <> pretty message
1071+ NotFound -> "Resource not found"
1072+ DbError {} -> "Something went wrong"
1073+ ErrorGettingBuildPlan {..} -> "Couldn't get build plan. Error was: " <> pretty message
1074+ ErrorGettingAttributesToBuild {..} -> "Couldn't get attributes to build. Error was: " <> pretty message
1075+ ProvisioningError {..} ->
1076+ "Error provisioning server:" <+> pretty message
1077+ ActivationError {serverInfo, stdErr} ->
1078+ pretty
1079+ $ T.unlines
1080+ [ "Failed to activate server",
1081+ "You may be able to debug this by sshing into "
1082+ <> cs (_serverInfoIpv4Addr serverInfo)
1083+ <> " or "
1084+ <> cs (_serverInfoIpv6Addr serverInfo),
1085+ "Stderr:",
1086+ stdErr
1087+ ]
1088+ SshTimeout {command} ->
1089+ pretty $ "ssh command timed out: " <> command
1090+ OtherError message -> pretty message
1091+ DecodeConfigError {..} ->
1092+ "Error decoding garnix.yaml:"
1093+ <+> pretty message
1094+ RunProcessError {..} ->
1095+ pretty
1096+ $ obfuscateGithubToken
1097+ $ show
1098+ ( "Command"
1099+ <+> Pretty.squotes (pretty (command <> " " <> T.unwords arguments))
1100+ <+> "failed with exit code"
1101+ <+> pretty (show exitCode)
1102+ <> "."
1103+ <> Pretty.softline
1104+ <> "Standard err was:"
1105+ <> Pretty.line
1106+ <> pretty stdErr
1107+ )
1108+ InvalidEmail -> "Invalid email address"
1109+ InvalidAccessToken -> "Invalid access token"
1110+ EntitlementError {message} ->
1111+ pretty message
1112+ DevModeOnly -> "dev mode only"
1113+ DeploymentWantsNixosConfigurationsThatDontExist packages -> "Deployment wants package(s) that have not been built: " <> pretty packages
1114+ NameIsNotValidSubdomain kind name -> pretty kind <+> "name" <+> Pretty.squotes (pretty name) <+> "is not a valid subdomain name."
1115+ TransactionAlreadyStarted -> "Internal transaction error."
1116+ BuildAlreadyStopped {buildId} -> "Build with id" <+> pretty buildId <+> "has already been stopped."
1117+ InvalidBuildUpdate {buildUpdateBody} -> "Invalid build update:" <+> pretty (decodeUtf8 $ BSL.toStrict (encodePretty buildUpdateBody))
1118+ FailedToParseDrvFile {drvFile, message} -> "Failed to parse " <+> pretty drvFile <+> ": " <+> pretty message
1119+ CachedError inner -> "(cached error)" <+> pretty (err inner)
1120+ GarnixAppUnauthorized owner repo -> Pretty.squotes (pretty owner) <+> "uninstalled or did not give enough permissions to the garnix app for" <+> Pretty.squotes (pretty repo)
1121+ GithubRequestTimeout -> "Request timeout when talking with Github."
1122+ FailedToParseCreateReportResult value -> "Failed to parse create report response: " <> Pretty.squotes (pretty $ show value)
1123+ ModuleErrorFlakeExists -> "This repo already has a flake.nix file. You should be able to use garnix without using modules."
1124+ ActionExecutionTimeout -> "The action took too long to complete and it was cancelled."
1125+ ActionPreconditionNixStore p -> "The action's 'program' needs to be a (path) from a derivation. Program is: " <> Pretty.squotes (pretty p)
1126+ ActionPreconditionFileExists p -> "The action's 'program' is wrong. Please make sure the path exists and that you're not trying to pass arguments via the 'program' field. Program is: " <> Pretty.squotes (pretty p)
1127+ ActionSandboxTypeNotAllowed typ -> "You are not allowed to run actions with the '" <> pretty typ <> "'. If you want access, get in touch with us."
1128+ ActionEvaluationFailure t -> "Evaluation for the action failed: " <> Pretty.line <> pretty t
1129+ ActionKeyDecryptionFailure -> "Could not decrypt private key."
1130+
1131+instance ToJSON Error where
1132+ toJSON x =
1133+ Aeson.object
1134+ $ [ "status" Aeson..= ("error" :: Text),
1135+ "message" Aeson..= msg
1136+ ]
1137+ ++ additionalFields
1138+ where
1139+ msg = showPretty x
1140+ additionalFields = case x of
1141+ NoSuchUser user -> ["garnixUser" Aeson..= user]
1142+ _ -> []
1143+
1144+servantizeError :: ErrorWithContext -> Servant.ServerError
1145+servantizeError e =
1146+ let details = toErrorDetails e
1147+ in Servant.ServerError
1148+ (statusCode details)
1149+ (cs $ statusMessage $ toEnum $ statusCode details)
1150+ (cs $ userMessage details)
1151+ (headers details)
1152+
1153+-- Unsafe constructor, use `errorDetails` instead!
1154+data ErrorDetails = UnsafeErrorDetails
1155+ { statusCode :: Int,
1156+ headers :: [Network.HTTP.Types.Header],
1157+ -- | An error message that is safe to display to the user
1158+ userMessage :: Text
1159+ }
1160+
1161+errorDetails :: Int -> Text -> ErrorDetails
1162+errorDetails statusCode userMessage = UnsafeErrorDetails statusCode [] (obfuscateGithubToken userMessage)
1163+
1164+fromStatusCode :: Int -> ErrorDetails
1165+fromStatusCode statusCode = errorDetails statusCode $ cs $ statusMessage $ toEnum statusCode
1166+
1167+toErrorDetails :: ErrorWithContext -> ErrorDetails
1168+toErrorDetails e = case err e of
1169+ UncaughtRuntimeException {} -> errorDetails 500 "Something went wrong"
1170+ RedirectFound {location} -> (fromStatusCode 302) {headers = [("location", cs location)]}
1171+ BadRequest {message} -> errorDetails 400 $ "Bad Request: " <> message
1172+ Unauthorized -> fromStatusCode 401
1173+ UnauthorizedWithMessage {message} -> errorDetails 401 $ "Unauthorized: " <> message
1174+ Forbidden -> fromStatusCode 403
1175+ ForbiddenWithMessage {message} -> errorDetails 403 $ "Forbidden: " <> message
1176+ NotFound -> fromStatusCode 404
1177+ e'@DecodeConfigError {} -> errorDetails 400 $ cs $ Aeson.encode e'
1178+ e'@DuplicateBuild -> errorDetails 409 $ cs $ Aeson.encode e'
1179+ e'@NoSuchBuild {} -> errorDetails 404 $ cs $ Aeson.encode e'
1180+ e'@NoSuchBuildRunId {} -> errorDetails 404 $ cs $ Aeson.encode e'
1181+ e'@NoSuchRun {} -> errorDetails 404 $ cs $ Aeson.encode e'
1182+ e'@NoSuchCommit {} -> errorDetails 404 $ cs $ Aeson.encode e'
1183+ e'@NoSuchUser {} -> errorDetails 404 $ cs $ Aeson.encode e'
1184+ e'@IsDeniedAccess -> errorDetails 403 $ cs $ Aeson.encode e'
1185+ e'@UserAlreadyExists {} -> errorDetails 409 $ cs $ Aeson.encode e'
1186+ e'@GithubDidntGiveUsAToken {} -> errorDetails 500 $ cs $ Aeson.encode e'
1187+ e'@InvalidEmail -> errorDetails 400 $ cs $ Aeson.encode e'
1188+ e'@InvalidAccessToken -> errorDetails 401 $ cs $ Aeson.encode e'
1189+ e'@RunProcessError {} ->
1190+ errorDetails 400
1191+ $ command e'
1192+ <> " "
1193+ <> T.unwords (arguments e')
1194+ <> " failed with exit code "
1195+ <> show (exitCode e')
1196+ <> "\nStderr:\n"
1197+ <> stdErr e'
1198+ DecodeError _ _ ->
1199+ errorDetails 500 "Decode error"
1200+ DbError _ _ ->
1201+ fromStatusCode 500
1202+ e@(ErrorGettingBuildPlan _) ->
1203+ errorDetails 400 $ showPretty e
1204+ e@(ErrorGettingAttributesToBuild _) ->
1205+ errorDetails 400 $ showPretty e
1206+ ProvisioningError _errMsg ->
1207+ errorDetails 500 "Error provisioning server. This could be a temporary error."
1208+ ActivationError serverInfo stdErr ->
1209+ errorDetails 400 $ "Error activating server at " <> _serverInfoIpv4Addr serverInfo <> ": " <> stdErr
1210+ SshTimeout {command} ->
1211+ errorDetails 500 $ "Timeout: ssh command " <> command
1212+ OtherError errMsg ->
1213+ errorDetails 500 errMsg
1214+ EntitlementError message ->
1215+ errorDetails 403 message
1216+ DevModeOnly -> fromStatusCode 404
1217+ DeploymentWantsNixosConfigurationsThatDontExist packages ->
1218+ errorDetails 400
1219+ $ "NixOS configuration(s) not found: "
1220+ <> T.intercalate ", " (map getPackageName packages)
1221+ NameIsNotValidSubdomain kind name ->
1222+ errorDetails 400 $ show kind <> " name '" <> name <> "' is not a valid subdomain name."
1223+ TransactionAlreadyStarted ->
1224+ errorDetails 500 "Internal transaction error"
1225+ BuildAlreadyStopped {} ->
1226+ errorDetails 400 "Build has already been stopped."
1227+ InvalidBuildUpdate {} ->
1228+ errorDetails 500 "Invalid build update."
1229+ NoSuchRepo {..} ->
1230+ errorDetails 404
1231+ $ "The repo https://github.com/"
1232+ <> getGhLogin (getGhRepoOwner _owner)
1233+ <> "/"
1234+ <> getGhRepoName _name
1235+ <> " doesn't exist, has not enabled garnix, or you don't have access to it."
1236+ FailedToParseDrvFile {drvFile, message} -> errorDetails 500 $ "Failed to parse drv file " <> cs drvFile <> ": " <> message
1237+ CachedError inner ->
1238+ let details = toErrorDetails inner
1239+ in details
1240+ { userMessage = "(cached error) " <> userMessage details
1241+ }
1242+ GarnixAppUnauthorized (GhRepoOwner (GhLogin owner)) (GhRepoName repo) ->
1243+ errorDetails 403 $ "The Garnix application does not have enough rights or was removed from '" <> show owner <> "/" <> show repo <> "'"
1244+ GithubRequestTimeout -> errorDetails 503 "Request timeout when talking with Github."
1245+ FailedToParseCreateReportResult _ -> errorDetails 500 "Internal error when creating report."
1246+ ModuleErrorFlakeExists -> errorDetails 400 $ show $ pretty $ err e
1247+ ActionExecutionTimeout -> errorDetails 400 $ show $ pretty $ err e
1248+ ActionPreconditionNixStore _ -> errorDetails 400 $ show $ pretty $ err e
1249+ ActionPreconditionFileExists _ -> errorDetails 400 $ show $ pretty $ err e
1250+ ActionSandboxTypeNotAllowed _ -> errorDetails 403 $ show $ pretty $ err e
1251+ ActionEvaluationFailure _ -> errorDetails 400 $ show $ pretty $ err e
1252+ ActionKeyDecryptionFailure -> errorDetails 400 $ show $ pretty $ err e
1253+
1254+data SubscriptionType
1255+ = FreeSubscription
1256+ | Admin
1257+ deriving stock (Eq, Show, Generic)
1258+
1259+instance ToJSON SubscriptionType where
1260+ toJSON = \case
1261+ FreeSubscription -> "free"
1262+ Admin -> "admin"
1263+
1264+instance FromJSON SubscriptionType where
1265+ parseJSON = Aeson.withText "subscription_type" $ \case
1266+ "free" -> pure FreeSubscription
1267+ "admin" -> pure Admin
1268+ _ -> mzero
1269+
1270+instance PGType "subscription_type" where
1271+ type PGVal "subscription_type" = SubscriptionType
1272+
1273+instance PGParameter "subscription_type" SubscriptionType where
1274+ pgEncode _ status = case status of
1275+ FreeSubscription -> "free"
1276+ Admin -> "admin"
1277+
1278+instance PGColumn "subscription_type" SubscriptionType where
1279+ pgDecode _ status = case status of
1280+ "free" -> FreeSubscription
1281+ "admin" -> Admin
1282+ e -> error $ "Impossible: unknown subscription type " <> cs e
1283+
1284+newtype UserId = UserId {getUserId :: Int32}
1285+ deriving stock (Eq, Show, Generic)
1286+ deriving newtype (ToJSON, Ord, FromJSON, PGColumn "integer", PGParameter "integer")
1287+
1288+data User = User
1289+ { _userId :: UserId,
1290+ _userGithubLogin :: GhLogin,
1291+ _userEmail :: Email,
1292+ _userSubscriptionType :: SubscriptionType,
1293+ _userCreatedAt :: UTCTime
1294+ }
1295+ deriving stock (Eq, Show, Generic)
1296+
1297+instance ToJSON User where
1298+ toEncoding = ourToEncoding
1299+ toJSON = ourToJSON
1300+
1301+instance FromJSON User where parseJSON = ourParseJSON
1302+
1303+data AuthJwtPayload = WebSession User GhToken | ApiSession User
1304+ deriving stock (Eq, Show, Generic)
1305+ deriving anyclass (ToJWT, FromJWT)
1306+
1307+instance {-# OVERLAPS #-} HasField' "user" AuthJwtPayload User where
1308+ field' :: Lens' AuthJwtPayload User
1309+ field' =
1310+ lens
1311+ ( \case
1312+ WebSession user _ -> user
1313+ ApiSession user -> user
1314+ )
1315+ ( \payload user -> case payload of
1316+ WebSession _user tok -> WebSession user tok
1317+ ApiSession _user -> ApiSession user
1318+ )
1319+
1320+instance ToJSON AuthJwtPayload where
1321+ toJSON (WebSession user ghToken) =
1322+ JSON.Object
1323+ $ ("id" Aeson..= _userId user)
1324+ <> ("github_login" Aeson..= _userGithubLogin user)
1325+ <> ("email" Aeson..= _userEmail user)
1326+ <> ("subscription_type" Aeson..= _userSubscriptionType user)
1327+ <> ("created_at" Aeson..= _userCreatedAt user)
1328+ <> ("github_token" Aeson..= ghToken)
1329+ toJSON (ApiSession user) =
1330+ JSON.Object
1331+ $ ("id" Aeson..= _userId user)
1332+ <> ("github_login" Aeson..= _userGithubLogin user)
1333+ <> ("email" Aeson..= _userEmail user)
1334+ <> ("subscription_type" Aeson..= _userSubscriptionType user)
1335+ <> ("created_at" Aeson..= _userCreatedAt user)
1336+
1337+instance FromJSON AuthJwtPayload where
1338+ parseJSON = withObject "AuthJwtPayload" $ \obj -> do
1339+ user <- parseJSON (Aeson.Object obj)
1340+ token <- obj Aeson..:? "github_token"
1341+ pure $ maybe (ApiSession user) (WebSession user) token
1342+
1343+newtype CustomerId = CustomerId {getCustomerId :: Text}
1344+ deriving stock (Generic, Show, Eq)
1345+ deriving newtype (ToJSON, FromJSON, Wreq.FormValue)
1346+
1347+newtype InvoiceId = InvoiceId {getInvoiceId :: Text}
1348+ deriving stock (Generic, Show, Eq)
1349+ deriving newtype (ToJSON, FromJSON, Wreq.FormValue)
1350+
1351+newtype SubscriptionId = SubscriptionId {getSubscriptionId :: Text}
1352+ deriving stock (Generic, Show, Eq, Ord)
1353+ deriving newtype (ToJSON, FromJSON, Wreq.FormValue)
1354+
1355+data InstallationStatus
1356+ = NoActiveInstallation
1357+ | InstallationRenewing UTCTime
1358+ | InstallationCancelling UTCTime
1359+ deriving stock (Eq, Show, Generic)
1360+
1361+instance ToJSON InstallationStatus where
1362+ toEncoding = ourToEncoding
1363+ toJSON = ourToJSON
1364+
1365+data CreatingUser a = CreatingUser
1366+ { _creatingUserExists :: Bool,
1367+ _creatingUserGithubLogin :: GhLogin,
1368+ _creatingUserEmail :: Email,
1369+ _creatingUserGithubToken :: a
1370+ }
1371+ deriving stock (Eq, Show, Generic, Functor)
1372+ deriving anyclass (ToJWT, FromJWT)
1373+
1374+instance (ToJSON a) => ToJSON (CreatingUser a) where
1375+ toEncoding = ourToEncoding
1376+ toJSON = ourToJSON
1377+
1378+instance (FromJSON a) => FromJSON (CreatingUser a) where parseJSON = ourParseJSON
1379+
1380+data CreateUser = CreateUser
1381+ { _createUserEmail :: Email,
1382+ _createUserSubscriptionType :: SubscriptionType,
1383+ _createUserAgreeToEmails :: Bool
1384+ }
1385+ deriving stock (Eq, Show, Generic)
1386+ deriving anyclass (ToJWT, FromJWT)
1387+
1388+instance ToJSON CreateUser where
1389+ toEncoding = ourToEncoding
1390+ toJSON = ourToJSON
1391+
1392+instance FromJSON CreateUser where parseJSON = ourParseJSON
1393+
1394+data LoginLinks = LoginLinks
1395+ {_loginLinksGithub :: T.Text}
1396+ deriving stock (Eq, Show, Generic)
1397+
1398+instance ToJSON LoginLinks where
1399+ toEncoding = ourToEncoding
1400+ toJSON = ourToJSON
1401+
1402+instance FromJSON LoginLinks where parseJSON = ourParseJSON
1403+
1404+data SignupLinks = SignupLinks
1405+ { _signupLinksGithub :: T.Text
1406+ }
1407+ deriving stock (Eq, Show, Generic)
1408+
1409+instance ToJSON SignupLinks where
1410+ toEncoding = ourToEncoding
1411+ toJSON = ourToJSON
1412+
1413+instance FromJSON SignupLinks where parseJSON = ourParseJSON
1414+
1415+data UserOverview = UserOverview
1416+ { _userOverviewRepos :: [UserOverviewRepo]
1417+ }
1418+ deriving stock (Eq, Show, Generic)
1419+
1420+instance ToJSON UserOverview where
1421+ toEncoding = ourToEncoding
1422+ toJSON = ourToJSON
1423+
1424+instance FromJSON UserOverview where parseJSON = ourParseJSON
1425+
1426+newtype OAuthCode = OAuthCode {getOAuthCode :: T.Text}
1427+ deriving stock (Eq, Show, Generic)
1428+ deriving newtype (ToJSON, FromJSON, Servant.FromHttpApiData, Servant.ToHttpApiData)
1429+
1430+-- | Yes this really must be at least Int64
1431+newtype GhRunId = GhRunId {getGhRunId :: Int64}
1432+ deriving stock (Eq, Generic)
1433+ deriving newtype
1434+ ( ToJSON,
1435+ FromJSON,
1436+ Num,
1437+ Ord,
1438+ Show,
1439+ PGParameter "bigint",
1440+ PGColumn "bigint",
1441+ Pretty
1442+ )
1443+
1444+data DoesFileExist = FileExists | FileDoesntExist
1445+ deriving (Eq, Show)
1446+
1447+newtype PullRequestResult = PullRequestResult
1448+ { _pullRequestResultUrl :: Text
1449+ }
1450+ deriving stock (Generic)
1451+
1452+instance ToJSON PullRequestResult where
1453+ toEncoding = ourToEncoding
1454+ toJSON = ourToJSON
1455+
1456+-- * Hosting Types
1457+
1458+newtype ServerId = ServerId {getServerId :: HashId}
1459+ deriving stock (Eq, Show, Generic)
1460+ deriving newtype
1461+ ( ToJSON,
1462+ FromJSON,
1463+ FromHttpApiData,
1464+ ToHttpApiData,
1465+ PGColumn "bigint",
1466+ PGParameter "bigint"
1467+ )
1468+
1469+instance Pretty ServerId where
1470+ pretty = pretty . getHashId . getServerId
1471+
1472+newtype PreprovisionedServerId = PreprovisionedServerId {getPreprovisionedServerId :: Int64}
1473+ deriving stock (Eq, Show, Generic)
1474+ deriving newtype
1475+ ( ToJSON,
1476+ FromJSON,
1477+ FromHttpApiData,
1478+ ToHttpApiData,
1479+ PGColumn "bigint",
1480+ PGParameter "bigint"
1481+ )
1482+
1483+instance Pretty PreprovisionedServerId where
1484+ pretty = pretty . getPreprovisionedServerId
1485+
1486+newtype HetznerServerId = HetznerServerId {getHetznerServerId :: Int32}
1487+ deriving stock (Eq, Show, Ord, Generic)
1488+ deriving newtype
1489+ ( ToJSON,
1490+ FromJSON,
1491+ FromHttpApiData,
1492+ ToHttpApiData,
1493+ PGColumn "integer",
1494+ PGParameter "integer",
1495+ Enum
1496+ )
1497+
1498+instance Pretty HetznerServerId where
1499+ pretty = pretty . show . getHetznerServerId
1500+
1501+data ServerInfo = ServerInfo
1502+ { _serverInfoId :: ServerId,
1503+ _serverInfoHetznerServerId :: HetznerServerId,
1504+ _serverInfoIpv4Addr :: Text,
1505+ _serverInfoIpv6Addr :: Text,
1506+ _serverInfoCreatedAt :: UTCTime,
1507+ _serverInfoEndedAt :: Maybe UTCTime,
1508+ _serverInfoConfigurationBuildId :: BuildId,
1509+ _serverInfoPullRequest :: Maybe GhPullRequestId,
1510+ _serverInfoReadyAt :: Maybe UTCTime,
1511+ _serverInfoBuildPersistenceName :: Maybe Text,
1512+ _serverInfoTier :: ServerTier,
1513+ _serverInfoIsPrimary :: Bool
1514+ }
1515+ deriving stock (Eq, Show, Generic)
1516+
1517+instance Pretty ServerInfo where
1518+ pretty s =
1519+ "server:"
1520+ <+> Pretty.line
1521+ <+> Pretty.nest
1522+ 2
1523+ ( vsep
1524+ [ "id:" <+> pretty (_serverInfoId s),
1525+ "hetzner id:" <+> pretty (_serverInfoHetznerServerId s),
1526+ "ipv4:" <+> pretty (_serverInfoIpv4Addr s),
1527+ "ipv6:" <+> pretty (_serverInfoIpv6Addr s),
1528+ "created at:" <+> pretty (show $ _serverInfoCreatedAt s),
1529+ "initialized at:" <+> pretty (show $ _serverInfoReadyAt s),
1530+ "ended at:" <+> pretty (show $ _serverInfoEndedAt s)
1531+ ]
1532+ )
1533+
1534+data DeploymentType
1535+ = BranchDeployment Branch
1536+ | GhPrDeployment GhPullRequestId
1537+ deriving stock (Eq, Show, Generic)
1538+
1539+instance ToJSON DeploymentType where
1540+ toJSON = ourToJSON
1541+
1542+fromDeploymentType :: (Branch -> a) -> (GhPullRequestId -> a) -> DeploymentType -> a
1543+fromDeploymentType a b = \case
1544+ BranchDeployment branch -> a branch
1545+ GhPrDeployment prId -> b prId
1546+
1547+ghPrDeployment :: DeploymentType -> Maybe GhPullRequestId
1548+ghPrDeployment = fromDeploymentType (const Nothing) Just
1549+
1550+data PreprovisionedServer = PreprovisionedServer
1551+ { _preprovisionedServerId :: PreprovisionedServerId,
1552+ _preprovisionedServerHetznerServerId :: HetznerServerId,
1553+ _preprovisionedServerIpv4Addr :: Text,
1554+ _preprovisionedServerIpv6Addr :: Text,
1555+ _preprovisionedServerCreatedAt :: UTCTime,
1556+ _preprovisionedServerReadyAt :: Maybe UTCTime
1557+ }
1558+ deriving stock (Eq, Show, Generic)
1559+
1560+-- * DeployPlan
1561+
1562+data ServerToSpinUp = ServerToSpinUp
1563+ { serverTier :: ServerTier,
1564+ build :: Build,
1565+ domainIsPrimary :: Bool
1566+ }
1567+ deriving stock (Show, Eq, Generic)
1568+
1569+data DeployPlan = DeployPlan
1570+ { toSpinDown :: [ServerInfo],
1571+ toSpinUp :: [ServerToSpinUp],
1572+ toRedeploy :: [(ServerInfo, Build)]
1573+ }
1574+ deriving stock (Show, Eq, Generic)
1575+
1576+-- * FrontendConfig
1577+
1578+data FrontendConfig = FrontendConfig
1579+ { _frontendConfigGithubAppName :: Text
1580+ }
1581+ deriving stock (Eq, Show, Generic)
1582+
1583+instance ToJSON FrontendConfig where
1584+ toEncoding = ourToEncoding
1585+ toJSON = ourToJSON
1586+
1587+-- * Log
1588+
1589+data LogItem = LogItem
1590+ { severity :: Severity,
1591+ context :: [(Text, Text)],
1592+ msg :: Text
1593+ }
1594+ deriving stock (Show, Eq, Generic)
1595+
1596+instance FastLogger.ToLogStr LogItem where
1597+ toLogStr logItem =
1598+ toLogStr
1599+ $ Aeson.encodingToLazyByteString
1600+ $ Aeson.pairs
1601+ ( "logLevel"
1602+ Aeson..= show (logItem ^. #severity)
1603+ <> foldMap (\(a, b) -> AesonKey.fromText a Aeson..= b) (context logItem)
1604+ <> ("message" Aeson..= msg logItem)
1605+ )
1606+
1607+data Severity
1608+ = -- | Critical conditions, alert the entire dev team. An action is likely required.
1609+ -- | Examples: system down, database down, invariant does not hold, etc.
1610+ Critical
1611+ | -- | Error conditions, notify the alerts channel. Action may or may not be required.
1612+ -- | Examples: Any sort of unexpected error case that does not fit into `Critical`.
1613+ Error
1614+ | -- | Expected errors, user errors, etc.
1615+ -- | Examples: eval errors, build errors, build timeouts, etc.
1616+ Warning
1617+ | -- | Key events that we may want to follow for a specific build.
1618+ -- | Examples: pr/branch webhook received, build started, etc.
1619+ Notice
1620+ | -- | Information that is useful to log for users/customer support.
1621+ -- | Examples: Individual package build start/completion, detailed deployment events, debugging info, etc.
1622+ Informational
1623+ deriving (Eq, Enum, Bounded, Read, Show, Ord)
1624+
1625+newtype PrHostList = PrHostList
1626+ { prHostList :: [Host]
1627+ }
1628+ deriving stock (Eq, Show, Generic)
1629+
1630+hostToDomainName :: Host -> Text
1631+hostToDomainName host =
1632+ getPackageName (_hostPackageName host)
1633+ <> "."
1634+ <> maybe (getBranch (_hostBranch host)) (("pull-" <>) . show . getGhPullRequestId) (_hostPullRequest host)
1635+ <> "."
1636+ <> getGhRepoName (_hostRepoName host)
1637+ <> "."
1638+ <> getGhLogin (getGhRepoOwner (_hostRepoOwner host))
1639+
1640+data Host = Host
1641+ { _hostRepoOwner :: GhRepoOwner,
1642+ _hostRepoName :: GhRepoName,
1643+ _hostBranch :: Branch,
1644+ _hostPackageName :: PackageName,
1645+ _hostPullRequest :: Maybe GhPullRequestId,
1646+ _hostIpV4Addr :: Text,
1647+ _hostIpV6Addr :: Text,
1648+ _hostDrvPath :: Maybe FilePath,
1649+ _hostPersistenceName :: Maybe Text,
1650+ _hostServerId :: ServerId,
1651+ _hostHetznerId :: HetznerServerId,
1652+ _hostIsPrimary :: Bool
1653+ }
1654+ deriving stock (Eq, Show, Generic)
1655+
1656+newtype Candidate a = Candidate {promoteCandidate :: a}
1657+
1658+-- * opensearch
1659+
1660+data OpenSearchId
1661+ = FromRun RunId
1662+ | FromBuild BuildId
1663+ deriving stock (Eq, Show, Generic)
1664+
1665+data OpenSearchMessage = OpenSearchMessage
1666+ { _openSearchMessageTimestamp :: UTCTime,
1667+ _openSearchMessagePackage :: Maybe PackageName,
1668+ _openSearchMessagePhase :: Maybe Text,
1669+ _openSearchMessageLogMessage :: Text
1670+ }
1671+ deriving stock (Eq, Show, Generic)
1672+
1673+instance ToJSON OpenSearchMessage where
1674+ toEncoding = ourToEncoding
1675+ toJSON = ourToJSON
1676+
1677+-- * combined data types
1678+
1679+data CommitInfo = CommitInfo
1680+ { _commitInfoReqUser :: GhLogin,
1681+ _commitInfoRepoPublicity :: RepoPublicity,
1682+ _commitInfoRepoInfo :: RepoInfo,
1683+ _commitInfoBranch :: Maybe Branch,
1684+ _commitInfoPrFromFork :: Maybe PrFromFork,
1685+ _commitInfoCommit :: CommitHash
1686+ }
1687+ deriving stock (Show)
1688+
1689+data RepoInfo = RepoInfo
1690+ { _repoInfoInstallationAuth :: InstallationAuth,
1691+ _repoInfoGhToken :: GhToken,
1692+ _repoInfoGhRepoOwner :: GhRepoOwner,
1693+ _repoInfoGhRepoName :: GhRepoName
1694+ }
1695+
1696+instance Show RepoInfo where
1697+ show (RepoInfo _iAuth _ghToken repoOwner repoName) =
1698+ "RepoInfo <iAuth> <ghToken>" <> unwords [Prelude.show repoOwner, Prelude.show repoName]
1699+
1700+data PackageInfo = PackageInfo
1701+ { _packageInfoPackageType :: PackageType,
1702+ _packageInfoMaybeSystem :: MaybeSystem,
1703+ _packageInfoPackageName :: PackageName
1704+ }
1705+
1706+data BuildKind = Webhook | ModulePreview
1707+
1708+data RepoConfig = RepoConfig
1709+ { _repoConfigSkipPrivateInputsCheckForCollaborators :: Bool,
1710+ _repoConfigMaxEvalMemory :: Memory
1711+ }
1712+ deriving stock (Show)
1713+
1714+defaultRepoConfig :: RepoConfig
1715+defaultRepoConfig = RepoConfig False (fromGigabytes 8)
1716+
1717+newtype Memory = Memory Int64
1718+ deriving stock (Show, Eq, Generic, Ord)
1719+ deriving newtype
1720+ ( PGColumn "bigint",
1721+ PGParameter "bigint"
1722+ )
1723+
1724+data ProductPlan = ProductPlan
1725+ { _productPlanDisplayName :: Text,
1726+ _productPlanDescription :: Maybe Text,
1727+ _productPlanBaseCiTime :: Duration,
1728+ _productPlanMaximumPrDeploymentTime :: Duration,
1729+ _productPlanIncludedBranchDeploymentHosts :: Int64,
1730+ _productPlanMaximumPackagesPerFlake :: Int32,
1731+ _productPlanPackageEvaluationTimeout :: Int16,
1732+ _productPlanPackageBuildTimeout :: Int16,
1733+ _productPlanExtraUsage :: ExtraUsageLimits,
1734+ _productPlanIsPaid :: Bool
1735+ }
1736+ deriving stock (Eq, Show, Generic)
1737+
1738+instance ToJSON ProductPlan where
1739+ toEncoding = ourToEncoding
1740+ toJSON = ourToJSON
1741+
1742+data ExtraUsageLimits = ExtraUsageLimits
1743+ { ciTime :: Duration,
1744+ prDeployTime :: Duration,
1745+ hostingSpend :: MonetaryCost
1746+ }
1747+ deriving (Eq, Show, Generic, ToJSON)
1748+
1749+instance FromJSON ExtraUsageLimits where
1750+ parseJSON = withObject "ExtraUsageLimits" $ \v -> do
1751+ limits <- genericParseJSON defaultOptions $ Aeson.Object v
1752+ when (limits ^. #ciTime < emptyDuration) $ fail "CI time cannot be negative"
1753+ when (limits ^. #prDeployTime < emptyDuration) $ fail "PR deploy time cannot be negative"
1754+ when (limits ^. #hostingSpend < usd 0) $ fail "Hosting spend cannot be negative"
1755+ pure limits
1756+
1757+emptyUsageLimits :: ExtraUsageLimits
1758+emptyUsageLimits =
1759+ ExtraUsageLimits
1760+ { ciTime = emptyDuration,
1761+ prDeployTime = emptyDuration,
1762+ hostingSpend = usd 0
1763+ }
1764+
1765+toBytes :: Memory -> Int64
1766+toBytes (Memory bytes) = bytes
1767+
1768+fromGigabytes :: Int64 -> Memory
1769+fromGigabytes gbs = Memory $ gbs * 1024 * 1024 * 1024
1770+
1771+data DatabaseConnection
1772+ = ConnectionPool (Pool PGConnection)
1773+ | Transaction PGConnection
1774+
1775+makeFields ''Repo
1776+makeFields ''Build
1777+makeFields ''OpenSearchMessage
1778+makeFields ''Package
1779+makeFields ''GhRun
1780+makeFields ''RunOutput
1781+makeFields ''User
1782+makeFields ''CreatingUser
1783+makeFields ''CreateUser
1784+makeFields ''ServerInfo
1785+makeFields ''PreprovisionedServer
1786+makeFields ''Host
1787+makeFields ''CommitInfo
1788+makeFields ''RepoInfo
1789+makeFields ''PackageInfo
1790+makeFields ''RepoConfig
1791+makeFields ''CommitSummary
1792+makeFields ''BuildUpdate
1793+makeFields ''Commit
1794+makeFields ''Run
1795+makeFields ''ProductPlan
1796+
1797+makePrisms ''User
1798+makePrisms ''Repo
1799+makePrisms ''Build
1800+makePrisms ''ServerInfo
1801+makePrisms ''Host
1802+makePrisms ''CommitInfo
1803+makePrisms ''PackageInfo
1804+makePrisms ''RepoInfo
1805+makePrisms ''CommitStatus
1806+makePrisms ''CheckStatus
1807+makePrisms ''Commit
1808+makePrisms ''FullCommitState