{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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
import Servant.API.Generic

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 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
$cto :: forall route x. Rep (DeployAPI route) x -> DeployAPI route
$cfrom :: forall route x. DeployAPI route -> Rep (DeployAPI route) x
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