Switch to gitlab-api-types for the GitLab API data

gitlab-ci-build-statuses.cabal

@@ -82,6 +82,7 @@ library
     , either
     , extra
     , githash
+    , gitlab-api-types
     , higgledy
     , http-conduit
     , http-link-header
@@ -142,6 +143,7 @@ test-suite gitlab-ci-build-statuses-test
   build-depends:
       base >=4.7 && <5
     , containers
+    , gitlab-api-types
     , gitlab-ci-build-statuses
     , hedgehog
     , hspec

package.yaml

@@ -57,6 +57,7 @@ library:
     - either
     - extra
     - githash
+    - gitlab-api-types
     - higgledy
     - http-conduit
     - http-link-header
@@ -106,6 +107,7 @@ tests:
     dependencies:
       - gitlab-ci-build-statuses
       - containers
+      - gitlab-api-types
       - hedgehog
       - hspec
       - hspec-hedgehog

src/Config/Backbone.hs

@@ -14,11 +14,14 @@ where
 
 import Config.Config
 import Control.Lens
-import Core.BuildStatuses (BuildStatuses, Project)
-import Core.Runners (Runner, RunnersJobs)
-import Core.Shared
+import Core.BuildStatuses (BuildStatuses)
+import Core.Runners (RunnersJobs)
 import Data.Cache (Cache)
 import GitHash
+import Gitlab.Group (Group)
+import Gitlab.Lib (Id)
+import Gitlab.Project (Project)
+import Gitlab.Runner (Runner)
 import Katip (LogContexts, LogEnv, Namespace)
 import Metrics.Metrics
 import Ports.Outbound.Gitlab.Projects qualified as Projects (initCache)

src/Config/Config.hs

@@ -22,13 +22,15 @@ where
 import Barbies
 import Config.Util
 import Control.Lens
-import Core.BuildStatuses (Project)
-import Core.Shared (DataUpdateIntervalSeconds (..), Group, Id (..), Url (..))
+import Core.Shared (DataUpdateIntervalSeconds (..))
 import Data.Biapplicative
 import Data.ByteString qualified as B hiding (pack)
 import Data.Char (toLower)
 import Data.Generic.HKD
 import Data.List.Extra (splitOn)
+import Gitlab.Group (Group)
+import Gitlab.Lib (Id (..), Url (..))
+import Gitlab.Project (Project)
 import Katip (Severity (..))
 import Network.URI (parseAbsoluteURI)
 import Relude hiding (lookupEnv)

src/Config/Interpreters.hs

@@ -9,6 +9,10 @@ import Core.BuildStatuses
 import Core.Runners
 import Core.Shared
 import Data.Cache (Cache)
+import Gitlab.Group (Group)
+import Gitlab.Lib (Id, Url)
+import Gitlab.Project (Project)
+import Gitlab.Runner (Runner)
 import Metrics.Metrics
 import Polysemy
 import Polysemy.Reader

src/Core/BuildStatuses.hs

@@ -3,10 +3,10 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Core.BuildStatuses
-  ( BuildStatus (..),
-    BuildStatuses (..),
+  ( BuildStatuses (..),
     filterResults,
     Result (..),
     ProjectsApi (..),
@@ -22,24 +22,24 @@ module Core.BuildStatuses
     getSinglePipeline,
     DetailedPipeline (..),
     Pipeline (..),
-    Project (..),
-    ProjectNamespace (..),
-    ProjectNamespaceFullPath (..),
     isHealthy,
     toResult,
   )
 where
 
-import Core.Shared
+import Core.Shared (UpdateError)
 import Data.Time (UTCTime (..))
-import Path
+import Gitlab.Group
+import Gitlab.Job (JobStatus (..))
+import Gitlab.Lib (Id, Name, Ref, Url)
+import Gitlab.Project (Project (..), ProjectNamespace (..), ProjectNamespaceFullPath)
 import Polysemy
 import Relude
 
 data Pipeline = Pipeline
   { pipelineId :: Id Pipeline,
     pipelineRef :: Ref,
-    pipelineStatus :: BuildStatus,
+    pipelineStatus :: JobStatus,
     pipelineWebUrl :: Url Pipeline
   }
   deriving stock (Generic, Show)
@@ -54,27 +54,11 @@ data Result = Result
   { projId :: Id Project,
     name :: Name Project,
     namespace :: ProjectNamespaceFullPath,
-    buildStatus :: BuildStatus,
+    buildStatus :: JobStatus,
     url :: Either (Url Project) (Url Pipeline)
   }
   deriving stock (Eq, Show)
 
-data BuildStatus
-  = Unknown
-  | Cancelled
-  | Created
-  | Failed
-  | Manual
-  | Pending
-  | Preparing
-  | Running
-  | Scheduled
-  | Skipped
-  | Successful
-  | SuccessfulWithWarnings
-  | WaitingForResource
-  deriving stock (Bounded, Enum, Eq, Show, Ord)
-
 data BuildStatuses = NoSuccessfulUpdateYet | Statuses (UTCTime, [Result])
 
 filterResults :: BuildStatuses -> (Result -> Bool) -> BuildStatuses
@@ -84,32 +68,14 @@ filterResults (Statuses (t, res)) f = Statuses (t, filter f res)
 data DetailedPipeline = DetailedPipeline
   { detailedPipelineId :: Id Pipeline,
     detailedPipelineRef :: Ref,
-    detailedPipelineStatus :: BuildStatus,
+    detailedPipelineStatus :: JobStatus,
     detailedPipelineWebUrl :: Url Pipeline
   }
 
-data Project = Project
-  { projectId :: Id Project,
-    projectName :: Name Project,
-    projectWebUrl :: Url Project,
-    projectDefaultBranch :: Maybe Ref,
-    projectNamespace :: ProjectNamespace
-  }
-  deriving stock (Eq, Generic, Show)
-
+-- todo: is this right?
 instance Ord Project where
   p1 <= p2 = projectId p1 <= projectId p2
 
-data ProjectNamespace = ProjectNamespace
-  { projectNamespaceId :: Id ProjectNamespace,
-    projectNamespaceFullPath :: ProjectNamespaceFullPath
-  }
-  deriving stock (Eq, Generic, Show)
-
-newtype ProjectNamespaceFullPath = ProjectNamespaceFullPath (Path Rel Dir)
-  deriving stock (Generic)
-  deriving newtype (Eq, Ord, Show)
-
 data PipelinesApi m a where
   GetLatestPipelineForRef :: Id Project -> Ref -> PipelinesApi m (Either UpdateError Pipeline)
   GetSinglePipeline :: Id Project -> Id Pipeline -> PipelinesApi m (Either UpdateError DetailedPipeline)
@@ -133,7 +99,7 @@ data BuildStatusesApi m a where
 
 makeSem ''BuildStatusesApi
 
-isHealthy :: BuildStatus -> Bool
+isHealthy :: JobStatus -> Bool
 isHealthy Unknown = False
 isHealthy Cancelled = False
 isHealthy Created = True
@@ -148,6 +114,6 @@ isHealthy Successful = True
 isHealthy SuccessfulWithWarnings = False
 isHealthy WaitingForResource = True
 
-toResult :: Project -> Maybe (BuildStatus, Url Pipeline) -> Result
+toResult :: Project -> Maybe (JobStatus, Url Pipeline) -> Result
 toResult Project {..} Nothing = Result projectId projectName (projectNamespaceFullPath projectNamespace) Unknown (Left projectWebUrl)
 toResult Project {..} (Just (status, url)) = Result projectId projectName (projectNamespaceFullPath projectNamespace) status (Right url)

src/Core/Jobs.hs

@@ -10,17 +10,19 @@ module Core.Jobs
   )
 where
 
-import Core.BuildStatuses (BuildStatus, Project)
 import Core.Shared
+import Gitlab.Job (JobStatus)
+import Gitlab.Lib (Id)
+import Gitlab.Project (Project)
 import Polysemy (makeSem)
 import Relude
 
 data Job = Job
   { jobId :: Id Job,
-    jobStatus :: BuildStatus
+    jobStatus :: JobStatus
   }
 
 data JobsApi m a where
-  GetJobsWithStatuses :: Id Project -> NonEmpty BuildStatus -> JobsApi m (Either UpdateError [Job])
+  GetJobsWithStatuses :: Id Project -> NonEmpty JobStatus -> JobsApi m (Either UpdateError [Job])
 
 makeSem ''JobsApi

src/Core/OverallStatus.hs

@@ -5,8 +5,9 @@ module Core.OverallStatus
   )
 where
 
-import Core.BuildStatuses (BuildStatus, BuildStatuses (..), Result (buildStatus))
-import Core.BuildStatuses qualified as B (BuildStatus (..))
+import Core.BuildStatuses (BuildStatuses (..), Result (buildStatus))
+import Gitlab.Job (JobStatus)
+import Gitlab.Job qualified as J (JobStatus (..))
 import Relude
 
 data OverallStatus
@@ -54,17 +55,17 @@ overallStatus :: BuildStatuses -> OverallStatus
 overallStatus NoSuccessfulUpdateYet = Unknown
 overallStatus (Statuses (_, statuses)) = foldMap (resultToOverall . buildStatus) statuses
 
-resultToOverall :: BuildStatus -> OverallStatus
-resultToOverall B.Unknown = Unknown
-resultToOverall B.Cancelled = Failed
-resultToOverall B.Created = Running
-resultToOverall B.Failed = Failed
-resultToOverall B.Manual = Warning
-resultToOverall B.Pending = Running
-resultToOverall B.Preparing = Running
-resultToOverall B.Running = Running
-resultToOverall B.Scheduled = Running
-resultToOverall B.Skipped = Warning
-resultToOverall B.Successful = Successful
-resultToOverall B.SuccessfulWithWarnings = Warning
-resultToOverall B.WaitingForResource = Warning
+resultToOverall :: JobStatus -> OverallStatus
+resultToOverall J.Unknown = Unknown
+resultToOverall J.Cancelled = Failed
+resultToOverall J.Created = Running
+resultToOverall J.Failed = Failed
+resultToOverall J.Manual = Warning
+resultToOverall J.Pending = Running
+resultToOverall J.Preparing = Running
+resultToOverall J.Running = Running
+resultToOverall J.Scheduled = Running
+resultToOverall J.Skipped = Warning
+resultToOverall J.Successful = Successful
+resultToOverall J.SuccessfulWithWarnings = Warning
+resultToOverall J.WaitingForResource = Warning

src/Core/Runners.hs

@@ -2,14 +2,11 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Core.Runners
-  ( Runner (..),
-    Description (..),
-    Tag (..),
-    Job (..),
+  ( Job (..),
     Stage (..),
-    IpAddress (..),
     RunnersJobs (..),
     RunnersApi (..),
     getOnlineRunnersForGroup,
@@ -21,28 +18,18 @@ module Core.Runners
   )
 where
 
-import Core.BuildStatuses (Project)
-import Core.Shared
+import Core.Shared (UpdateError)
 import Data.Time (UTCTime)
+import Gitlab.Group (Group)
+import Gitlab.Lib (Id, Name, Ref, Url)
+import Gitlab.Project (Project)
+import Gitlab.Runner
 import Polysemy (makeSem)
 import Relude
 
-data Runner = Runner
-  { runnerId :: Id Runner,
-    runnerName :: Maybe (Name Runner),
-    runnerDescription :: Description,
-    runnerIpAddress :: Maybe IpAddress,
-    runnerTagList :: [Tag]
-  }
-  deriving stock (Eq, Generic)
-
 instance Ord Runner where
   compare r1 r2 = compare (runnerId r1) (runnerId r2)
 
-newtype Description = Description Text deriving newtype (Eq)
-
-newtype Tag = Tag Text deriving newtype (Eq)
-
 data Job = Job
   { jobId :: Id Job,
     jobProjectId :: Id Project,
@@ -55,8 +42,6 @@ data Job = Job
 
 newtype Stage = Stage Text
 
-newtype IpAddress = IpAddress Text deriving newtype (Eq)
-
 data RunnersJobs = NoSuccessfulUpdateYet | RunnersJobs (UTCTime, Map Runner [Job])
 
 data RunnersApi m a where

src/Core/Shared.hs

@@ -2,23 +2,15 @@
 
 module Core.Shared
   ( DataUpdateIntervalSeconds (..),
-    Group,
-    Id (..),
-    Url (..),
-    Name (..),
     UpdateError (..),
-    Ref (..),
   )
 where
 
 import Data.ByteString.Lazy qualified as L
 import Network.HTTP.Simple (HttpException, Request, Response)
 import Network.HTTP.Types (Status)
-import Network.URI
 import Relude
 
-data Group
-
 data UpdateError
   = HttpError HttpException
   | JSONError Request (Response L.ByteString) String
@@ -30,11 +22,3 @@ newtype DataUpdateIntervalSeconds = DataUpdateIntervalSeconds Int
   deriving stock (Show)
   deriving (Num) via Int
   deriving newtype (Eq)
-
-newtype Id a = Id Int deriving newtype (Eq, Hashable, Ord, Show)
-
-newtype Url a = Url URI deriving newtype (Eq, Show)
-
-newtype Ref = Ref Text deriving newtype (Eq, Ord, Show)
-
-newtype Name a = Name Text deriving newtype (Eq, Show)