{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}

module Cachix.API.Deploy.V1 where

import Cachix.API (CachixAuth)
import qualified Cachix.Types.Deploy as Deploy
import qualified Cachix.Types.DeployResponse.V1 as DeployResponse.V1
import qualified Cachix.Types.Deployment as Deployment
import Data.UUID (UUID)
import Protolude
import Servant.API

type API = "api" :> "v1" :> ToServantApi DeployAPI

data DeployAPI route = DeployAPI
  { forall route. DeployAPI route -> route :- Activate
activate :: route :- Activate,
    forall route. DeployAPI route -> route :- GetDeployment
getDeployment :: route :- GetDeployment
  }
  deriving ((forall x. DeployAPI route -> Rep (DeployAPI route) x)
-> (forall x. Rep (DeployAPI route) x -> DeployAPI route)
-> Generic (DeployAPI route)
forall x. Rep (DeployAPI route) x -> DeployAPI route
forall x. DeployAPI route -> Rep (DeployAPI route) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall route x. Rep (DeployAPI route) x -> DeployAPI route
forall route x. DeployAPI route -> Rep (DeployAPI route) x
$cfrom :: forall route x. DeployAPI route -> Rep (DeployAPI route) x
from :: forall x. DeployAPI route -> Rep (DeployAPI route) x
$cto :: forall route x. Rep (DeployAPI route) x -> DeployAPI route
to :: forall x. Rep (DeployAPI route) x -> DeployAPI route
Generic)

type Activate =
  CachixAuth
    :> "deploy"
    :> "activate"
    :> ReqBody '[JSON] Deploy.Deploy
    :> Post '[JSON] DeployResponse.V1.DeployResponse

type GetDeployment =
  CachixAuth
    :> "deploy"
    :> "deployment"
    :> Capture "uuid" UUID
    :> Get '[JSON] Deployment.Deployment