{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE CPP                 #-}

{-|
Low level library with aeson Object's for releases fetched from Bodhi API.
-}

module Distribution.Fedora.BodhiReleases (
  getBodhiReleases,
  getBodhiProductReleases,
  getBodhiFedoraReleases,
  getBodhiEPELReleases,
  getBodhiBranchReleases,
  lookupKey
  )
where

import Control.Exception.Extra (retry)
import Data.Aeson (Object)
import Fedora.Bodhi (bodhiReleases, makeKey)
import System.Cached.JSON

-- FIXME softer/warning on failure?
-- | Get Releases from Fedora Bodhi API (excluding archived)
getBodhiReleases :: IO [Object]
getBodhiReleases :: IO [Object]
getBodhiReleases =
  Int -> IO [Object] -> IO [Object]
forall a. Int -> IO a -> IO a
retry Int
2 (IO [Object] -> IO [Object]) -> IO [Object] -> IO [Object]
forall a b. (a -> b) -> a -> b
$
  String -> String -> IO [Object] -> NominalDiffTime -> IO [Object]
forall a.
(FromJSON a, ToJSON a) =>
String -> String -> IO a -> NominalDiffTime -> IO a
getCachedJSONQuery String
"fedora" String
"bodhi-releases.json"
  (Query -> IO [Object]
bodhiReleases (String -> String -> Query
makeKey String
"exclude_archived" String
"True")) NominalDiffTime
450

-- | Get Releases from Bodhi API filtered by id_prefix
getBodhiProductReleases :: String -> IO [Object]
getBodhiProductReleases :: String -> IO [Object]
getBodhiProductReleases String
name =
  [Object] -> [Object]
forall a. [a] -> [a]
reverse ([Object] -> [Object])
-> ([Object] -> [Object]) -> [Object] -> [Object]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Object -> Bool) -> [Object] -> [Object]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Object
r -> Text -> Object -> Maybe String
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"id_prefix" Object
r Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
name) ([Object] -> [Object]) -> IO [Object] -> IO [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Object]
getBodhiReleases

-- | Get FEDORA Releases from Bodhi API
getBodhiFedoraReleases :: IO [Object]
getBodhiFedoraReleases :: IO [Object]
getBodhiFedoraReleases =
  String -> IO [Object]
getBodhiProductReleases String
"FEDORA"

-- | Get FEDORA-EPEL Releases from Bodhi API
getBodhiEPELReleases :: IO [Object]
getBodhiEPELReleases :: IO [Object]
getBodhiEPELReleases =
  String -> IO [Object]
getBodhiProductReleases String
"FEDORA-EPEL"

-- | Get releases for branch name
getBodhiBranchReleases :: String -> IO [Object]
getBodhiBranchReleases :: String -> IO [Object]
getBodhiBranchReleases String
br =
  (Object -> Bool) -> [Object] -> [Object]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Object
r -> Text -> Object -> Maybe String
forall a. FromJSON a => Text -> Object -> Maybe a
lookupKey Text
"branch" Object
r Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
br) ([Object] -> [Object]) -> IO [Object] -> IO [Object]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Object]
getBodhiReleases