{-# LANGUAGE OverloadedStrings #-}

{- |
Copyright: (c) 2020 Jens Petersen
SPDX-License-Identifier: MIT
Maintainer: Jens Petersen <juhpetersen@gmail.com>

Fedora Bodhi REST client library
-}

module Fedora.Bodhi
  ( bodhiBuild
  , bodhiBuilds
  , bodhiComment
  , bodhiComments
  , bodhiCSRF
  , bodhiOverride
  , bodhiOverrides
  , bodhiOverrideDates
  , bodhiPackages
  , bodhiRelease
  , bodhiReleases
  , bodhiUpdate
  , bodhiUpdates
  , bodhiUser
  , bodhiUsers
  , lookupKey
  , lookupKey'
  , queryBodhi
  , makeKey
  , makeItem
  , maybeKey
  , Query
  , QueryItem
  ) where

import Data.Aeson.Types
import Data.Text (Text)
import Data.Time.LocalTime
import Network.HTTP.Query

server :: String
server :: [Char]
server = [Char]
"bodhi.fedoraproject.org"

-- | Returns build JSON for NVR
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/builds.html#service-0
bodhiBuild :: String -> IO Object
bodhiBuild :: [Char] -> IO Object
bodhiBuild [Char]
nvr =
  Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi [] ([Char] -> IO Object) -> [Char] -> IO Object
forall a b. (a -> b) -> a -> b
$ [Char]
"builds" [Char] -> [Char] -> [Char]
+/+ [Char]
nvr

-- | returns JSON list of builds
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/builds.html#service-1
bodhiBuilds :: Query -> IO [Object]
bodhiBuilds :: Query -> IO [Object]
bodhiBuilds Query
params =
  Text -> Object -> [Object]
forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"builds" (Object -> [Object]) -> IO Object -> IO [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi Query
params [Char]
"builds/"

-- | Returns comment JSON for id
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/comments.html#service-0
bodhiComment :: String -> IO Object
bodhiComment :: [Char] -> IO Object
bodhiComment [Char]
cid =
  Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi [] ([Char] -> IO Object) -> [Char] -> IO Object
forall a b. (a -> b) -> a -> b
$ [Char]
"comments" [Char] -> [Char] -> [Char]
+/+ [Char]
cid

-- | returns JSON list of comments
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/comments.html#service-1
bodhiComments :: Query -> IO [Object]
bodhiComments :: Query -> IO [Object]
bodhiComments Query
params =
  Text -> Object -> [Object]
forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"comments" (Object -> [Object]) -> IO Object -> IO [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi Query
params [Char]
"comments/"

-- | Get CSRF token
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/csrf.html
bodhiCSRF :: IO (Maybe Text)
bodhiCSRF :: IO (Maybe Text)
bodhiCSRF =
  Text -> Object -> Maybe Text
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"csrf_token" (Object -> Maybe Text) -> IO Object -> IO (Maybe Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi [] [Char]
"csrf"

-- | Returns override JSON for NVR
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/overrides.html#service-0
bodhiOverride :: String -> IO (Maybe Object)
bodhiOverride :: [Char] -> IO (Maybe Object)
bodhiOverride [Char]
nvr =
  Text -> Object -> Maybe Object
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"override" (Object -> Maybe Object) -> IO Object -> IO (Maybe Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi [] ([Char]
"overrides" [Char] -> [Char] -> [Char]
+/+ [Char]
nvr)

-- | Returns override expiration and submission dates for NVR
bodhiOverrideDates :: String -> IO (Maybe (LocalTime,LocalTime))
bodhiOverrideDates :: [Char] -> IO (Maybe (LocalTime, LocalTime))
bodhiOverrideDates [Char]
nvr = do
  Maybe Object
mobj <- [Char] -> IO (Maybe Object)
bodhiOverride [Char]
nvr
  case Maybe Object
mobj of
    Maybe Object
Nothing -> do
      [Char] -> IO ()
putStrLn ([Char] -> IO ()) -> [Char] -> IO ()
forall a b. (a -> b) -> a -> b
$ [Char]
"Override for " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
nvr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
" not found"
      Maybe (LocalTime, LocalTime) -> IO (Maybe (LocalTime, LocalTime))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (LocalTime, LocalTime)
forall a. Maybe a
Nothing
    Just Object
obj -> Maybe (LocalTime, LocalTime) -> IO (Maybe (LocalTime, LocalTime))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (LocalTime, LocalTime) -> IO (Maybe (LocalTime, LocalTime)))
-> Maybe (LocalTime, LocalTime)
-> IO (Maybe (LocalTime, LocalTime))
forall a b. (a -> b) -> a -> b
$ Object -> Maybe (LocalTime, LocalTime)
readDates Object
obj
  where
    readDates :: Object -> Maybe (LocalTime,LocalTime)
    readDates :: Object -> Maybe (LocalTime, LocalTime)
readDates =
      (Object -> Parser (LocalTime, LocalTime))
-> Object -> Maybe (LocalTime, LocalTime)
forall a b. (a -> Parser b) -> a -> Maybe b
parseMaybe ((Object -> Parser (LocalTime, LocalTime))
 -> Object -> Maybe (LocalTime, LocalTime))
-> (Object -> Parser (LocalTime, LocalTime))
-> Object
-> Maybe (LocalTime, LocalTime)
forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        LocalTime
expire <- Object
obj Object -> Key -> Parser LocalTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"expiration_date"
        LocalTime
submit <- Object
obj Object -> Key -> Parser LocalTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"submission_date"
        (LocalTime, LocalTime) -> Parser (LocalTime, LocalTime)
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (LocalTime
expire,LocalTime
submit)

-- | returns JSON list of overrides
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/overrides.html#service-1
bodhiOverrides :: Query -> IO [Object]
bodhiOverrides :: Query -> IO [Object]
bodhiOverrides Query
params =
  Text -> Object -> [Object]
forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"overrides" (Object -> [Object]) -> IO Object -> IO [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi Query
params [Char]
"overrides/"

-- | Packages query
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/packages.html#service-0
bodhiPackages :: Query -> IO [Object]
bodhiPackages :: Query -> IO [Object]
bodhiPackages Query
params =
  Text -> Object -> [Object]
forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"packages" (Object -> [Object]) -> IO Object -> IO [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi Query
params [Char]
"packages/"

-- | read releases metadata from Bodhi
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/releases.html#service-0
bodhiRelease :: String -> IO Object
bodhiRelease :: [Char] -> IO Object
bodhiRelease [Char]
rel =
  Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi [] ([Char] -> IO Object) -> [Char] -> IO Object
forall a b. (a -> b) -> a -> b
$ [Char]
"releases" [Char] -> [Char] -> [Char]
+/+ [Char]
rel

-- | read releases metadata from Bodhi
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/releases.html#service-1
bodhiReleases :: Query -> IO [Object]
-- FIXME handle errors:
-- fromList [("status",String "error"),("errors",Array [Object (fromList [("location",String "body"),("name",String "name"),("description",String "No such release")])])]
bodhiReleases :: Query -> IO [Object]
bodhiReleases Query
params =
  Text -> Object -> [Object]
forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"releases" (Object -> [Object]) -> IO Object -> IO [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi Query
params [Char]
"releases/"

-- | read an update from Bodhi
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/updates.html#service-0
bodhiUpdate :: String -> IO (Maybe Object)
bodhiUpdate :: [Char] -> IO (Maybe Object)
bodhiUpdate [Char]
update =
  Text -> Object -> Maybe Object
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"update" (Object -> Maybe Object) -> IO Object -> IO (Maybe Object)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi [] ([Char]
"updates" [Char] -> [Char] -> [Char]
+/+ [Char]
update)

-- | search for updates on Bodhi
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/updates.html#service-2
bodhiUpdates :: Query -> IO [Object]
bodhiUpdates :: Query -> IO [Object]
bodhiUpdates Query
params =
  Text -> Object -> [Object]
forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"updates" (Object -> [Object]) -> IO Object -> IO [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi Query
params [Char]
"updates/"

-- | user info from Bodhi
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/users.html#service-0
bodhiUser :: String -> IO Object
bodhiUser :: [Char] -> IO Object
bodhiUser [Char]
user =
  Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi [] ([Char] -> IO Object) -> [Char] -> IO Object
forall a b. (a -> b) -> a -> b
$ [Char]
"users" [Char] -> [Char] -> [Char]
+/+ [Char]
user

-- | list users from Bodhi
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/users.html#service-1
bodhiUsers :: Query -> IO [Object]
bodhiUsers :: Query -> IO [Object]
bodhiUsers Query
params =
  Text -> Object -> [Object]
forall a. FromJSON a => Text -> Object -> a
lookupKey' Text
"users" (Object -> [Object]) -> IO Object -> IO [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Query -> [Char] -> IO Object
forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi Query
params [Char]
"users/"

-- | low-level query
queryBodhi :: FromJSON a => Query -> String -> IO a
queryBodhi :: forall a. FromJSON a => Query -> [Char] -> IO a
queryBodhi Query
params [Char]
path =
  let url :: [Char]
url = [Char]
"https://" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
server [Char] -> [Char] -> [Char]
+/+ [Char]
path
  in [Char] -> Query -> IO a
forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
[Char] -> Query -> m a
webAPIQuery [Char]
url Query
params