{-# LANGUAGE CPP #-}

{- |
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

#if (defined(VERSION_lens_aeson))
import Control.Lens
import Data.Aeson.Lens
#else
import Lens.Micro
import Lens.Micro.Aeson
#endif
import Data.Aeson.Types
import Data.Text (Text)
import Data.Time.LocalTime
import Network.HTTP.Query

server :: String
server :: String
server = String
"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 :: String -> IO Object
bodhiBuild String
nvr = do
  Value
res <- Query -> String -> IO Value
queryBodhi [] (String -> IO Value) -> String -> IO Value
forall a b. (a -> b) -> a -> b
$ String
"builds" String -> String -> String
+/+ String
nvr
  Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> IO Object) -> Object -> IO Object
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting Object Value Object -> Object
forall s a. s -> Getting a s a -> a
^. Getting Object Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | 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 = do
  Value
res <- Query -> String -> IO Value
queryBodhi Query
params String
"builds/"
  [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Object] -> IO [Object]) -> [Object] -> IO [Object]
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (Endo [Object]) Value Object -> [Object]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"builds" ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Object]) Value)
-> Value -> Const (Endo [Object]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Object]) Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | Returns comment JSON for id
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/comments.html#service-0
bodhiComment :: String -> IO Object
bodhiComment :: String -> IO Object
bodhiComment String
cid = do
  Value
res <- Query -> String -> IO Value
queryBodhi [] (String -> IO Value) -> String -> IO Value
forall a b. (a -> b) -> a -> b
$ String
"comments" String -> String -> String
+/+ String
cid
  Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> IO Object) -> Object -> IO Object
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting Object Value Object -> Object
forall s a. s -> Getting a s a -> a
^. Getting Object Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | 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 = do
  Value
res <- Query -> String -> IO Value
queryBodhi Query
params String
"comments/"
  [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Object] -> IO [Object]) -> [Object] -> IO [Object]
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (Endo [Object]) Value Object -> [Object]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"comments" ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Object]) Value)
-> Value -> Const (Endo [Object]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Object]) Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | Get CSRF token
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/csrf.html
bodhiCSRF :: IO (Maybe Text)
bodhiCSRF :: IO (Maybe Text)
bodhiCSRF = do
  Value
res <- Query -> String -> IO Value
queryBodhi [] String
"csrf"
  Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (First Text) Value Text -> Maybe Text
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"csrf_token" ((Value -> Const (First Text) Value)
 -> Value -> Const (First Text) Value)
-> Getting (First Text) Value Text
-> Getting (First Text) Value Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Value Text
forall t. AsPrimitive t => Prism' t Text
_String

-- | Returns override JSON for NVR
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/overrides.html#service-0
bodhiOverride :: String -> IO (Maybe Object)
bodhiOverride :: String -> IO (Maybe Object)
bodhiOverride String
nvr = do
  Value
res <- Query -> String -> IO Value
queryBodhi [] (String -> IO Value) -> String -> IO Value
forall a b. (a -> b) -> a -> b
$ String
"overrides" String -> String -> String
+/+ String
nvr
  Maybe Object -> IO (Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Object -> IO (Maybe Object))
-> Maybe Object -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (First Object) Value Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"override" ((Value -> Const (First Object) Value)
 -> Value -> Const (First Object) Value)
-> Getting (First Object) Value Object
-> Getting (First Object) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Object) Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | Returns override expiration and submission dates for NVR
bodhiOverrideDates :: String -> IO (Maybe (LocalTime,LocalTime))
bodhiOverrideDates :: String -> IO (Maybe (LocalTime, LocalTime))
bodhiOverrideDates String
nvr = do
  Maybe Object
mobj <- String -> IO (Maybe Object)
bodhiOverride String
nvr
  case Maybe Object
mobj of
    Maybe Object
Nothing -> do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Override for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nvr String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" not found"
      Maybe (LocalTime, LocalTime) -> IO (Maybe (LocalTime, LocalTime))
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 (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 -> Text -> Parser LocalTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"expiration_date"
        LocalTime
submit <- Object
obj Object -> Text -> Parser LocalTime
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"submission_date"
        (LocalTime, LocalTime) -> Parser (LocalTime, LocalTime)
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 = do
  Value
res <- Query -> String -> IO Value
queryBodhi Query
params String
"overrides/"
  [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Object] -> IO [Object]) -> [Object] -> IO [Object]
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (Endo [Object]) Value Object -> [Object]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"overrides" ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Object]) Value)
-> Value -> Const (Endo [Object]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Object]) Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | 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 = do
  Value
res <- Query -> String -> IO Value
queryBodhi Query
params String
"packages/"
  [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Object] -> IO [Object]) -> [Object] -> IO [Object]
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (Endo [Object]) Value Object -> [Object]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"packages" ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Object]) Value)
-> Value -> Const (Endo [Object]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Object]) Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | read releases metadata from Bodhi
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/releases.html#service-0
bodhiRelease :: String -> IO Object
bodhiRelease :: String -> IO Object
bodhiRelease String
rel = do
  Value
res <- Query -> String -> IO Value
queryBodhi [] (String -> IO Value) -> String -> IO Value
forall a b. (a -> b) -> a -> b
$ String
"releases" String -> String -> String
+/+ String
rel
  Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> IO Object) -> Object -> IO Object
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting Object Value Object -> Object
forall s a. s -> Getting a s a -> a
^. Getting Object Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | read releases metadata from Bodhi
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/releases.html#service-1
bodhiReleases :: Query -> IO [Object]
bodhiReleases :: Query -> IO [Object]
bodhiReleases Query
params = do
  Value
res <- Query -> String -> IO Value
queryBodhi Query
params String
"releases/"
  [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Object] -> IO [Object]) -> [Object] -> IO [Object]
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (Endo [Object]) Value Object -> [Object]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"releases" ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Object]) Value)
-> Value -> Const (Endo [Object]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Object]) Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | read an update from Bodhi
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/updates.html#service-0
bodhiUpdate :: String -> IO (Maybe Object)
bodhiUpdate :: String -> IO (Maybe Object)
bodhiUpdate String
update = do
  Value
res <- Query -> String -> IO Value
queryBodhi [] (String -> IO Value) -> String -> IO Value
forall a b. (a -> b) -> a -> b
$ String
"updates" String -> String -> String
+/+ String
update
  Maybe Object -> IO (Maybe Object)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Object -> IO (Maybe Object))
-> Maybe Object -> IO (Maybe Object)
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (First Object) Value Object -> Maybe Object
forall s a. s -> Getting (First a) s a -> Maybe a
^? Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"update" ((Value -> Const (First Object) Value)
 -> Value -> Const (First Object) Value)
-> Getting (First Object) Value Object
-> Getting (First Object) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Object) Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | 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 = do
  Value
res <- Query -> String -> IO Value
queryBodhi Query
params String
"updates/"
  [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Object] -> IO [Object]) -> [Object] -> IO [Object]
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (Endo [Object]) Value Object -> [Object]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"updates" ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Object]) Value)
-> Value -> Const (Endo [Object]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Object]) Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | user info from Bodhi
--
-- https://bodhi.fedoraproject.org/docs/server_api/rest/users.html#service-0
bodhiUser :: String -> IO Object
bodhiUser :: String -> IO Object
bodhiUser String
user = do
  Value
res <- Query -> String -> IO Value
queryBodhi [] (String -> IO Value) -> String -> IO Value
forall a b. (a -> b) -> a -> b
$ String
"users" String -> String -> String
+/+ String
user
  Object -> IO Object
forall (m :: * -> *) a. Monad m => a -> m a
return (Object -> IO Object) -> Object -> IO Object
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting Object Value Object -> Object
forall s a. s -> Getting a s a -> a
^. Getting Object Value Object
forall t. AsValue t => Prism' t Object
_Object

-- | 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 = do
  Value
res <- Query -> String -> IO Value
queryBodhi Query
params String
"users/"
  [Object] -> IO [Object]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Object] -> IO [Object]) -> [Object] -> IO [Object]
forall a b. (a -> b) -> a -> b
$ Value
res Value -> Getting (Endo [Object]) Value Object -> [Object]
forall s a. s -> Getting (Endo [a]) s a -> [a]
^.. Text -> Traversal' Value Value
forall t. AsValue t => Text -> Traversal' t Value
key Text
"users" ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Const (Endo [Object]) Value)
-> Value -> Const (Endo [Object]) Value
forall t. AsValue t => IndexedTraversal' Int t Value
values ((Value -> Const (Endo [Object]) Value)
 -> Value -> Const (Endo [Object]) Value)
-> Getting (Endo [Object]) Value Object
-> Getting (Endo [Object]) Value Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (Endo [Object]) Value Object
forall t. AsValue t => Prism' t Object
_Object

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