{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Version
-- Description : Queries about GitLab instance version
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2020
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Version where

import qualified Data.ByteString.Lazy as BSL
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Client

-- | Retrieve version information for this GitLab instance.
gitlabVersion :: GitLab (Either (Response BSL.ByteString) (Maybe Version))
gitlabVersion :: GitLab (Either (Response ByteString) (Maybe Version))
gitlabVersion = do
  let urlPath :: Text
urlPath = Text
"/version"
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Version))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
urlPath []