{-# LANGUAGE CPP #-}

-- |
-- Module      :  Distribution.Fedora
-- Copyright   :  (C) 2014-2020  Jens Petersen
--
-- Maintainer  :  Jens Petersen <petersen@fedoraproject.org>
--
-- Explanation: Fedora Dist type and functions

-- This program is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation, either version 3 of the License, or
-- (at your option) any later version.

module Distribution.Fedora
  (Dist(..),
   getReleaseIds,
   getFedoraReleaseIds,
   getFedoraDists,
   getEPELReleaseIds,
   getRawhideDist,
   getLatestFedoraDist,
   getLatestEPELDist,
   rawhideVersionId,
   distBranch,
   distRepo,
   distUpdates,
   distOverride,
   mockConfig,
   distVersion,
   kojicmd,
   rpkg,
   rpmDistTag) where

import qualified Data.Text as T
import Data.Text (Text)
import Data.Version
import Text.Read
import Text.ParserCombinators.ReadP (char, eof, string)

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (*>))
import Data.Traversable (traverse)
#endif

import Distribution.Fedora.ReadProducts
import Distribution.Fedora.Products

-- | The `Dist` datatype specifies the target OS and version.
-- (roughly corresponds to a git branch)
data Dist = RHEL Version -- ^ RHEL version
          | EPEL Int -- ^ EPEL release
          | Fedora Int -- ^ Fedora release
  deriving (Dist -> Dist -> Bool
(Dist -> Dist -> Bool) -> (Dist -> Dist -> Bool) -> Eq Dist
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Dist -> Dist -> Bool
$c/= :: Dist -> Dist -> Bool
== :: Dist -> Dist -> Bool
$c== :: Dist -> Dist -> Bool
Eq, Eq Dist
Eq Dist
-> (Dist -> Dist -> Ordering)
-> (Dist -> Dist -> Bool)
-> (Dist -> Dist -> Bool)
-> (Dist -> Dist -> Bool)
-> (Dist -> Dist -> Bool)
-> (Dist -> Dist -> Dist)
-> (Dist -> Dist -> Dist)
-> Ord Dist
Dist -> Dist -> Bool
Dist -> Dist -> Ordering
Dist -> Dist -> Dist
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Dist -> Dist -> Dist
$cmin :: Dist -> Dist -> Dist
max :: Dist -> Dist -> Dist
$cmax :: Dist -> Dist -> Dist
>= :: Dist -> Dist -> Bool
$c>= :: Dist -> Dist -> Bool
> :: Dist -> Dist -> Bool
$c> :: Dist -> Dist -> Bool
<= :: Dist -> Dist -> Bool
$c<= :: Dist -> Dist -> Bool
< :: Dist -> Dist -> Bool
$c< :: Dist -> Dist -> Bool
compare :: Dist -> Dist -> Ordering
$ccompare :: Dist -> Dist -> Ordering
$cp1Ord :: Eq Dist
Ord)

instance Show Dist where
  show :: Dist -> String
show (Fedora Int
n) = String
"f" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
  show (EPEL Int
n) = (if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
6 then String
"el" else String
"epel") String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
  show (RHEL Version
v) = String
"rhel-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
v

-- | Read from eg "f29", "epel7"
instance Read Dist where
  readPrec :: ReadPrec Dist
readPrec = [ReadPrec Dist] -> ReadPrec Dist
forall a. [ReadPrec a] -> ReadPrec a
choice [ReadPrec Dist
pFedora, ReadPrec Dist
pEPEL, ReadPrec Dist
pRHEL] where
    pFedora :: ReadPrec Dist
pFedora = Int -> Dist
Fedora (Int -> Dist) -> ReadPrec Int -> ReadPrec Dist
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReadP Char -> ReadPrec Char
forall a. ReadP a -> ReadPrec a
lift (Char -> ReadP Char
char Char
'f') ReadPrec Char -> ReadPrec Int -> ReadPrec Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadPrec Int
forall a. Read a => ReadPrec a
readPrec)
    pEPEL :: ReadPrec Dist
pEPEL = Int -> Dist
EPEL (Int -> Dist) -> ReadPrec Int -> ReadPrec Dist
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReadP String -> ReadPrec String
forall a. ReadP a -> ReadPrec a
lift (String -> ReadP String
string String
"epel") ReadPrec String -> ReadPrec Int -> ReadPrec Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadPrec Int
forall a. Read a => ReadPrec a
readPrec)
    pRHEL :: ReadPrec Dist
pRHEL = Version -> Dist
RHEL (Version -> Dist) -> ReadPrec Version -> ReadPrec Dist
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Version -> ReadPrec Version
forall a. ReadP a -> ReadPrec a
lift (do
      Version
v <- String -> ReadP String
string String
"rhel-" ReadP String -> ReadP Version -> ReadP Version
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ReadP Version
parseVersion
      ReadP ()
eof
      Version -> ReadP Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
v)

getReleases :: IO [Release]
getReleases :: IO [Release]
getReleases = do
  String
file <- IO String
getProductsFile
  [Release] -> [Release]
forall a. [a] -> [a]
reverse ([Release] -> [Release]) -> IO [Release] -> IO [Release]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO [Release]
parseReleases String
file

-- | gets list of current releases (Fedora and EPEL)
--
-- The data is stored in ~/.fedora/product-versions.json
-- and refreshed from Fedora PDC if older than 5.5 hours
getReleaseIds :: IO [Text]
getReleaseIds :: IO [Text]
getReleaseIds = (Release -> Text) -> [Release] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Release -> Text
releaseProductVersionId ([Release] -> [Text]) -> IO [Release] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getReleases

getProductReleases :: Text -> IO [Release]
getProductReleases :: Text -> IO [Release]
getProductReleases Text
name =
  (Release -> Bool) -> [Release] -> [Release]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Release
p -> Release -> Text
releaseProduct Release
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) ([Release] -> [Release]) -> IO [Release] -> IO [Release]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getReleases

-- getRelease :: Text -> IO (Maybe Release)
-- getRelease pv =
--   find (\p -> releaseProductVersionId p == pv) <$> getReleases

getFedoraReleases :: IO [Release]
getFedoraReleases :: IO [Release]
getFedoraReleases =
  Text -> IO [Release]
getProductReleases (String -> Text
T.pack String
"fedora")

-- | gets current Fedora releases
getFedoraReleaseIds :: IO [Text]
getFedoraReleaseIds :: IO [Text]
getFedoraReleaseIds =
  (Release -> Text) -> [Release] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Release -> Text
releaseProductVersionId ([Release] -> [Text]) -> IO [Release] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getFedoraReleases

getEPELReleases :: IO [Release]
getEPELReleases :: IO [Release]
getEPELReleases =
  Text -> IO [Release]
getProductReleases (String -> Text
T.pack String
"epel")

-- | gets current EPEL releases
getEPELReleaseIds :: IO [Text]
getEPELReleaseIds :: IO [Text]
getEPELReleaseIds =
  (Release -> Text) -> [Release] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Release -> Text
releaseProductVersionId ([Release] -> [Text]) -> IO [Release] -> IO [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getEPELReleases

-- | Rawhide version id
rawhideVersionId :: Text
rawhideVersionId :: Text
rawhideVersionId = String -> Text
T.pack String
"fedora-rawhide"

-- fails on rawhide - only use on other releases
releaseMajorVersion :: Release -> Int
releaseMajorVersion :: Release -> Int
releaseMajorVersion = String -> Int
forall a. Read a => String -> a
read (String -> Int) -> (Release -> String) -> Release -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Release -> Text) -> Release -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> Text
releaseVersion

releaseDist :: Release -> Dist
releaseDist :: Release -> Dist
releaseDist = Int -> Dist
Fedora (Int -> Dist) -> (Release -> Int) -> Release -> Dist
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> Int
releaseMajorVersion

releaseDists :: [Release] -> [Dist]
releaseDists :: [Release] -> [Dist]
releaseDists [Release]
rels =
  (Release -> Dist) -> [Release] -> [Dist]
forall a b. (a -> b) -> [a] -> [b]
map Release -> Dist
mkDist [Release]
rels
  where
    mkDist :: Release -> Dist
    mkDist :: Release -> Dist
mkDist Release
r | Release -> Text
releaseProductVersionId Release
r Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
rawhideVersionId = Release -> Dist
newerDist Release
latestbranch
             | Bool
otherwise = Release -> Dist
releaseDist Release
r

    latestbranch :: Release
latestbranch = [Release] -> Release
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Release] -> Release) -> [Release] -> Release
forall a b. (a -> b) -> a -> b
$ (Release -> Bool) -> [Release] -> [Release]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Release
p -> Release -> Text
releaseProductVersionId Release
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rawhideVersionId) [Release]
rels

    newerDist :: Release -> Dist
newerDist = Int -> Dist
Fedora (Int -> Dist) -> (Release -> Int) -> Release -> Dist
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> (Release -> Int) -> Release -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> Int
releaseMajorVersion

-- | get list of current Fedora Dist's
getFedoraDists :: IO [Dist]
getFedoraDists :: IO [Dist]
getFedoraDists = [Release] -> [Dist]
releaseDists ([Release] -> [Dist]) -> IO [Release] -> IO [Dist]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getFedoraReleases

-- | get current Dist for Fedora Rawhide
getRawhideDist :: IO Dist
getRawhideDist :: IO Dist
getRawhideDist =
  [Dist] -> Dist
forall a. [a] -> a
head ([Dist] -> Dist) -> ([Release] -> [Dist]) -> [Release] -> Dist
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Release] -> [Dist]
releaseDists ([Release] -> Dist) -> IO [Release] -> IO Dist
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getFedoraReleases

-- | get newest Fedora branch
getLatestFedoraDist :: IO Dist
getLatestFedoraDist :: IO Dist
getLatestFedoraDist =
  Release -> Dist
releaseDist (Release -> Dist) -> ([Release] -> Release) -> [Release] -> Dist
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Release] -> Release
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Release] -> Release)
-> ([Release] -> [Release]) -> [Release] -> Release
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Release -> Bool) -> [Release] -> [Release]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Release
p -> Release -> Text
releaseProductVersionId Release
p Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
rawhideVersionId) ([Release] -> Dist) -> IO [Release] -> IO Dist
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getFedoraReleases

-- | get newest EPEL release
getLatestEPELDist :: IO Dist
getLatestEPELDist :: IO Dist
getLatestEPELDist =
  Int -> Dist
EPEL (Int -> Dist) -> ([Release] -> Int) -> [Release] -> Dist
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Release -> Int
releaseMajorVersion (Release -> Int) -> ([Release] -> Release) -> [Release] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Release] -> Release
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Release] -> Dist) -> IO [Release] -> IO Dist
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Release]
getEPELReleases

-- activeRelease :: Text -> IO Bool
-- activeRelease pv = do
--   res <- filter (\p -> releaseProductVersionId p == pv) <$> getReleases
--   return $ not (null res)

-- | Maps `Dist` to package dist-git branch name, relative to latest branch
--
-- > distBranch (Fedora 32) (Fedora 33) == "rawhide"
-- > distBranch (Fedora 32) (Fedora 31) == "f31"
distBranch :: Dist -- ^ latest branch
           -> Dist -> String
distBranch :: Dist -> Dist -> String
distBranch Dist
branch (Fedora Int
n) | Int -> Dist
Fedora Int
n Dist -> Dist -> Bool
forall a. Ord a => a -> a -> Bool
> Dist
branch = String
"rawhide"
distBranch Dist
_ Dist
d = Dist -> String
forall a. Show a => a -> String
show Dist
d

-- | Map `Dist` to DNF/YUM repo name, relative to latest branch
distRepo :: Dist -> Dist -> String
distRepo :: Dist -> Dist -> String
distRepo Dist
branched (Fedora Int
n) | Int -> Dist
Fedora Int
n Dist -> Dist -> Bool
forall a. Ord a => a -> a -> Bool
> Dist
branched = String
"rawhide"
                             | Bool
otherwise = String
"fedora"
distRepo Dist
_ (EPEL Int
_) = String
"epel"
distRepo Dist
_ (RHEL Version
_) = String
"rhel"

-- | Map `Dist` to Maybe the DNF/YUM updates repo name, relative to latest branch
distUpdates :: Dist -> Dist -> Maybe String
distUpdates :: Dist -> Dist -> Maybe String
distUpdates Dist
branched (Fedora Int
n) | Int -> Dist
Fedora Int
n Dist -> Dist -> Bool
forall a. Ord a => a -> a -> Bool
> Dist
branched  = Maybe String
forall a. Maybe a
Nothing
distUpdates Dist
_ (Fedora Int
_) = String -> Maybe String
forall a. a -> Maybe a
Just String
"updates"
distUpdates Dist
_ Dist
_ = Maybe String
forall a. Maybe a
Nothing

-- | Whether dist has overrides in Bodhi, relative to latest branch
distOverride :: Dist -> Dist -> Bool
distOverride :: Dist -> Dist -> Bool
distOverride Dist
branch (Fedora Int
n) = Int -> Dist
Fedora Int
n Dist -> Dist -> Bool
forall a. Ord a => a -> a -> Bool
<= Dist
branch
distOverride Dist
_ (EPEL Int
n) = Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
9
distOverride Dist
_ Dist
_ = Bool
False

-- | OS release major version for `Dist`, relative to latest branch
distVersion :: Dist -> Dist -> String
distVersion :: Dist -> Dist -> String
distVersion Dist
branch (Fedora Int
n) | Int -> Dist
Fedora Int
n Dist -> Dist -> Bool
forall a. Ord a => a -> a -> Bool
> Dist
branch = String
"rawhide"
distVersion Dist
_ (Fedora Int
n) = Int -> String
forall a. Show a => a -> String
show Int
n
distVersion Dist
_ (EPEL Int
n) = Int -> String
forall a. Show a => a -> String
show Int
n
distVersion Dist
_ (RHEL Version
n) = Version -> String
forall a. Show a => a -> String
show Version
n

-- | Mock configuration for `Dist` and arch, relative to latest branch
mockConfig :: Dist -> Dist -> String -> String
mockConfig :: Dist -> Dist -> ShowS
mockConfig Dist
branch Dist
dist String
arch =
  let prefix :: String
prefix =
        case Dist
dist of
          Fedora Int
_ -> String
"fedora"
          Dist
_ -> Dist -> Dist -> String
distRepo Dist
branch Dist
dist
  in
  String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Dist -> Dist -> String
distVersion Dist
branch Dist
dist String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"-" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
arch

-- | `Dist` tag (appended to rpm package release field)
rpmDistTag :: Dist -> String
rpmDistTag :: Dist -> String
rpmDistTag (Fedora Int
n) = String
".fc" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
rpmDistTag (EPEL Int
n) = String
".el" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
rpmDistTag (RHEL Version
v) = String
".el" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Version -> Int) -> Version -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> (Version -> [Int]) -> Version -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> [Int]
versionBranch) Version
v

-- | Command line tool for `Dist` (eg "koji")
kojicmd :: Dist -> String
kojicmd :: Dist -> String
kojicmd (RHEL Version
_) = String
"brew"
kojicmd Dist
_ =  String
"koji"

-- | rpkg command for `Dist` (eg "fedpkg")
rpkg :: Dist -> String
rpkg :: Dist -> String
rpkg (RHEL Version
_) = String
"rhpkg"
rpkg Dist
_ = String
"fedpkg"