{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      : Language.Github.Actions.Service
-- Description : GitHub Actions service containers for jobs
-- Copyright   : (c) 2025 Bellroy Pty Ltd
-- License     : BSD-3-Clause
-- Maintainer  : Bellroy Tech Team <haskell@bellroy.com>
--
-- This module provides the 'Service' type for defining service containers that run
-- alongside job steps in GitHub Actions workflows.
--
-- Service containers are Docker containers that provide services like databases,
-- message queues, or other dependencies that your job steps might need during execution.
-- They run in parallel with your job and are accessible via hostname.
--
-- For more information about GitHub Actions service containers, see:
-- <https://docs.github.com/en/actions/writing-workflows/workflow-syntax-for-github-actions#jobsjob_idservices>
module Language.Github.Actions.Service
  ( Service (..),
    gen,
    new,
  )
where

import Data.Aeson (FromJSON, ToJSON (..), (.:?), (.=))
import qualified Data.Aeson as Aeson
import Data.Map (Map)
import Data.Maybe (catMaybes)
import Data.Text (Text)
import GHC.Generics (Generic)
import Hedgehog (MonadGen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range

-- | A service container definition for GitHub Actions jobs.
--
-- Service containers run Docker images that provide services your job steps can use.
-- Common examples include databases, caches, and message queues.
--
-- Service containers are automatically started before job steps run and stopped after
-- the job completes. They can be accessed by job steps using their service ID as hostname.
--
-- Example usage:
--
-- @
-- import Language.Github.Actions.Service
-- import qualified Data.Map as Map
--
-- -- PostgreSQL database service
-- postgresService :: Service
-- postgresService = new
--  { image = Just "postgres:13"
--  , env = Just $ Map.fromList
--      [ ("POSTGRES_PASSWORD", "postgres")
--      , ("POSTGRES_DB", "testdb")
--      ]
--  , ports = Just ["5432:5432"]
--  }
--
-- -- Redis cache service
-- redisService :: Service
-- redisService = new
--  { image = Just "redis:6-alpine"
--  , ports = Just ["6379:6379"]
--  }
-- @
--
-- For more details, see: <https://docs.github.com/en/actions/writing-workflows/workflow-syntax-for-github-actions#jobsjob_idservices>
data Service = Service
  { -- | Registry credentials for private images
    Service -> Maybe (Map Text Text)
credentials :: Maybe (Map Text Text),
    -- | Environment variables for the service
    Service -> Maybe (Map Text Text)
env :: Maybe (Map Text Text),
    -- | Docker image to use for the service
    Service -> Maybe Text
image :: Maybe Text,
    -- | Additional Docker options
    Service -> Maybe Text
options :: Maybe Text,
    -- | Ports to expose from the service
    Service -> Maybe [Text]
ports :: Maybe [Text],
    -- | Volumes to mount in the service
    Service -> Maybe [Text]
volumes :: Maybe [Text]
  }
  deriving stock (Service -> Service -> Bool
(Service -> Service -> Bool)
-> (Service -> Service -> Bool) -> Eq Service
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Service -> Service -> Bool
== :: Service -> Service -> Bool
$c/= :: Service -> Service -> Bool
/= :: Service -> Service -> Bool
Eq, (forall x. Service -> Rep Service x)
-> (forall x. Rep Service x -> Service) -> Generic Service
forall x. Rep Service x -> Service
forall x. Service -> Rep Service x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Service -> Rep Service x
from :: forall x. Service -> Rep Service x
$cto :: forall x. Rep Service x -> Service
to :: forall x. Rep Service x -> Service
Generic, Eq Service
Eq Service =>
(Service -> Service -> Ordering)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Bool)
-> (Service -> Service -> Service)
-> (Service -> Service -> Service)
-> Ord Service
Service -> Service -> Bool
Service -> Service -> Ordering
Service -> Service -> Service
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Service -> Service -> Ordering
compare :: Service -> Service -> Ordering
$c< :: Service -> Service -> Bool
< :: Service -> Service -> Bool
$c<= :: Service -> Service -> Bool
<= :: Service -> Service -> Bool
$c> :: Service -> Service -> Bool
> :: Service -> Service -> Bool
$c>= :: Service -> Service -> Bool
>= :: Service -> Service -> Bool
$cmax :: Service -> Service -> Service
max :: Service -> Service -> Service
$cmin :: Service -> Service -> Service
min :: Service -> Service -> Service
Ord, Int -> Service -> ShowS
[Service] -> ShowS
Service -> String
(Int -> Service -> ShowS)
-> (Service -> String) -> ([Service] -> ShowS) -> Show Service
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Service -> ShowS
showsPrec :: Int -> Service -> ShowS
$cshow :: Service -> String
show :: Service -> String
$cshowList :: [Service] -> ShowS
showList :: [Service] -> ShowS
Show)

instance FromJSON Service where
  parseJSON :: Value -> Parser Service
parseJSON = String -> (Object -> Parser Service) -> Value -> Parser Service
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"Service" ((Object -> Parser Service) -> Value -> Parser Service)
-> (Object -> Parser Service) -> Value -> Parser Service
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe (Map Text Text)
credentials <- Object
o Object -> Key -> Parser (Maybe (Map Text Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"credentials"
    Maybe (Map Text Text)
env <- Object
o Object -> Key -> Parser (Maybe (Map Text Text))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"env"
    Maybe Text
image <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"image"
    Maybe Text
options <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"options"
    Maybe [Text]
ports <- Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"ports"
    Maybe [Text]
volumes <- Object
o Object -> Key -> Parser (Maybe [Text])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"volumes"
    Service -> Parser Service
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Service {Maybe [Text]
Maybe Text
Maybe (Map Text Text)
credentials :: Maybe (Map Text Text)
env :: Maybe (Map Text Text)
image :: Maybe Text
options :: Maybe Text
ports :: Maybe [Text]
volumes :: Maybe [Text]
credentials :: Maybe (Map Text Text)
env :: Maybe (Map Text Text)
image :: Maybe Text
options :: Maybe Text
ports :: Maybe [Text]
volumes :: Maybe [Text]
..}

instance ToJSON Service where
  toJSON :: Service -> Value
toJSON Service {Maybe [Text]
Maybe Text
Maybe (Map Text Text)
credentials :: Service -> Maybe (Map Text Text)
env :: Service -> Maybe (Map Text Text)
image :: Service -> Maybe Text
options :: Service -> Maybe Text
ports :: Service -> Maybe [Text]
volumes :: Service -> Maybe [Text]
credentials :: Maybe (Map Text Text)
env :: Maybe (Map Text Text)
image :: Maybe Text
options :: Maybe Text
ports :: Maybe [Text]
volumes :: Maybe [Text]
..} =
    [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
      [Maybe Pair] -> [Pair]
forall a. [Maybe a] -> [a]
catMaybes
        [ (Key
"credentials" Key -> Map Text Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Map Text Text -> Pair) -> Maybe (Map Text Text) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Map Text Text)
credentials,
          (Key
"env" Key -> Map Text Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Map Text Text -> Pair) -> Maybe (Map Text Text) -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Map Text Text)
env,
          (Key
"image" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
image,
          (Key
"options" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) (Text -> Pair) -> Maybe Text -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
options,
          (Key
"ports" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Text]
ports,
          (Key
"volumes" Key -> [Text] -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.=) ([Text] -> Pair) -> Maybe [Text] -> Maybe Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Text]
volumes
        ]

gen :: (MonadGen m) => m Service
gen :: forall (m :: * -> *). MonadGen m => m Service
gen = do
  Maybe (Map Text Text)
credentials <- m (Map Text Text) -> m (Maybe (Map Text Text))
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe m (Map Text Text)
genTextMap
  Maybe (Map Text Text)
env <- m (Map Text Text) -> m (Maybe (Map Text Text))
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe m (Map Text Text)
genTextMap
  Maybe Text
image <- m Text -> m (Maybe Text)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe m Text
genText
  Maybe Text
options <- m Text -> m (Maybe Text)
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe m Text
genText
  Maybe [Text]
ports <- m [Text] -> m (Maybe [Text])
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe (m [Text] -> m (Maybe [Text]))
-> (m Text -> m [Text]) -> m Text -> m (Maybe [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range Int -> m Text -> m [Text]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
3) (m Text -> m (Maybe [Text])) -> m Text -> m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ Range Int -> m Char -> m Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
5) m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.digit
  Maybe [Text]
volumes <- m [Text] -> m (Maybe [Text])
forall (m :: * -> *) a. MonadGen m => m a -> m (Maybe a)
Gen.maybe (m [Text] -> m (Maybe [Text]))
-> (m Text -> m [Text]) -> m Text -> m (Maybe [Text])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Range Int -> m Text -> m [Text]
forall (m :: * -> *) a. MonadGen m => Range Int -> m a -> m [a]
Gen.list (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
3) (m Text -> m (Maybe [Text])) -> m Text -> m (Maybe [Text])
forall a b. (a -> b) -> a -> b
$ m Text
genText
  Service -> m Service
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Service {Maybe [Text]
Maybe Text
Maybe (Map Text Text)
credentials :: Maybe (Map Text Text)
env :: Maybe (Map Text Text)
image :: Maybe Text
options :: Maybe Text
ports :: Maybe [Text]
volumes :: Maybe [Text]
credentials :: Maybe (Map Text Text)
env :: Maybe (Map Text Text)
image :: Maybe Text
options :: Maybe Text
ports :: Maybe [Text]
volumes :: Maybe [Text]
..}
  where
    genText :: m Text
genText = Range Int -> m Char -> m Text
forall (m :: * -> *). MonadGen m => Range Int -> m Char -> m Text
Gen.text (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
5) m Char
forall (m :: * -> *). MonadGen m => m Char
Gen.alphaNum
    genTextMap :: m (Map Text Text)
genTextMap = Range Int -> m (Text, Text) -> m (Map Text Text)
forall (m :: * -> *) k v.
(MonadGen m, Ord k) =>
Range Int -> m (k, v) -> m (Map k v)
Gen.map (Int -> Int -> Range Int
forall a. Integral a => a -> a -> Range a
Range.linear Int
1 Int
5) (m (Text, Text) -> m (Map Text Text))
-> m (Text, Text) -> m (Map Text Text)
forall a b. (a -> b) -> a -> b
$ (Text -> Text -> (Text, Text))
-> m Text -> m Text -> m (Text, Text)
forall a b c. (a -> b -> c) -> m a -> m b -> m c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) m Text
genText m Text
genText

-- | Create a new empty 'Service' with default values.
--
-- This provides a minimal service definition that can be extended with specific
-- image, ports, environment variables, and other configuration.
--
-- Example:
--
-- @
-- databaseService = new
--   { image = Just "postgres:13"
--   , env = Just $ Map.singleton "POSTGRES_PASSWORD" "secret"
--   , ports = Just ["5432:5432"]
--   }
-- @
new :: Service
new :: Service
new =
  Service
    { credentials :: Maybe (Map Text Text)
credentials = Maybe (Map Text Text)
forall a. Maybe a
Nothing,
      env :: Maybe (Map Text Text)
env = Maybe (Map Text Text)
forall a. Maybe a
Nothing,
      image :: Maybe Text
image = Maybe Text
forall a. Maybe a
Nothing,
      options :: Maybe Text
options = Maybe Text
forall a. Maybe a
Nothing,
      ports :: Maybe [Text]
ports = Maybe [Text]
forall a. Maybe a
Nothing,
      volumes :: Maybe [Text]
volumes = Maybe [Text]
forall a. Maybe a
Nothing
    }