module Distribution.Koji
( BuildID(..)
, BuildInfo(..)
, buildIDInfo
, fedoraKojiHub
, centosKojiHub
, kojiBuildTags
, kojiBuildTarget
, kojiGetBuildID
, kojiGetBuildState
, kojiGetBuildTaskID
, kojiGetCurrentRepo
, kojiGetRepo
, kojiGetTaskInfo
, kojiGetTaskChildren
, kojiGetTaskState
, kojiGetUserID
, kojiLatestBuild
, kojiLatestBuildRepo
, kojiListSideTags
, kojiListTaskIDs
, kojiUserBuildTasks
, KojiBuild(..)
, kojiListTaggedBuilds
, PackageID(..)
, TagID(..)
, TaskID(..)
, UserID(..)
, displayID
, getID
, readID
, readID'
, TaskState(..)
, getTaskState
, openTaskStates
, openTaskValues
, readTaskState
, BuildState(..)
, readBuildState
, Struct
, lookupStruct
, Value (..)
, getInt
, getString
, RepoState(..)
, readRepoState
)
where
import qualified Data.List as L
import Data.Maybe
import Network.XmlRpc.Internals
import Distribution.Koji.API
class ID a where
getID :: a -> Int
mkID :: Int -> a
displayID :: ID a => a -> String
displayID = show . getID
readID :: ID a => Struct -> Maybe a
readID st = lookup "id" st >>= fmap mkID . getInt
readID' :: Struct -> Maybe Int
readID' st = lookup "id" st >>= getInt
getInt :: Value -> Maybe Int
getInt (ValueInt i) = Just i
getInt _ = Nothing
getString :: Value -> Maybe String
getString (ValueString i) = Just i
getString _ = Nothing
newtype TaskID = TaskId Int
deriving Show
instance ID TaskID where
getID (TaskId i) = i
mkID = TaskId
newtype TagID = TagId Int
deriving Show
instance ID TagID where
getID (TagId i) = i
mkID = TagId
newtype UserID = UserId Int
deriving Show
instance ID UserID where
getID (UserId i) = i
mkID = UserId
newtype BuildID = BuildId Int
instance ID BuildID where
getID (BuildId i) = i
mkID = BuildId
newtype PackageID = PackageId Int
instance ID PackageID where
getID (PackageId i) = i
mkID = PackageId
newtype BuildrootID = BuildrootId Int
instance ID BuildrootID where
getID (BuildrootId i) = i
mkID = BuildrootId
data BuildInfo = BuildInfoID Int | BuildInfoNVR String
buildInfo :: BuildInfo -> Info
buildInfo (BuildInfoID bid) = InfoID bid
buildInfo (BuildInfoNVR nvr) = InfoString nvr
buildIDInfo :: BuildID -> BuildInfo
buildIDInfo (BuildId bid) = BuildInfoID bid
fedoraKojiHub :: String
fedoraKojiHub = "https://koji.fedoraproject.org/kojihub"
centosKojiHub :: String
centosKojiHub = "https://koji.mbox.centos.org/kojihub"
kojiGetBuildID :: String
-> String
-> IO (Maybe BuildID)
kojiGetBuildID hubUrl nvr =
((fmap BuildId . lookupStruct "id") =<<) <$> getBuild hubUrl (InfoString nvr)
kojiGetBuildTaskID :: String
-> String
-> IO (Maybe TaskID)
kojiGetBuildTaskID hubUrl nvr =
((fmap TaskId . lookupStruct "task_id") =<<) <$> getBuild hubUrl (InfoString nvr)
kojiListTaskIDs :: String
-> Struct
-> Struct
-> IO [TaskID]
kojiListTaskIDs hubUrl opts qopts =
mapMaybe readID <$> listTasks hubUrl opts qopts
kojiUserBuildTasks :: String
-> UserID
-> Maybe String
-> Maybe String
-> IO [TaskID]
kojiUserBuildTasks hubUrl userid msource mtarget = do
tasks <- listTasks hubUrl [("owner",ValueInt (getID userid)),("method",ValueString "build"),("state",openTaskValues)] []
return $ map TaskId . mapMaybe (lookupStruct "id") $ filter isTheBuild tasks
where
isTheBuild :: Struct -> Bool
isTheBuild st =
let mreq = lookupStruct "request" st in
case mreq of
Nothing -> False
Just req ->
maybe True (`L.isInfixOf` req) msource &&
maybe True (\ target -> ("<value><string>" ++ target ++ "</string></value>") `L.isInfixOf` req) mtarget
kojiGetUserID :: String
-> String
-> IO (Maybe UserID)
kojiGetUserID hubUrl name = do
res <- getUser hubUrl (InfoString name) False
return $ readID =<< res
kojiBuildTags :: String
-> BuildInfo
-> IO [String]
kojiBuildTags hubUrl buildinfo = do
lst <- listTags hubUrl (Just (buildInfo buildinfo)) Nothing False
return $ mapMaybe (lookupStruct "name") lst
data BuildState = BuildBuilding
| BuildComplete
| BuildDeleted
| BuildFailed
| BuildCanceled
deriving (Eq, Enum, Show)
readBuildState :: Value -> BuildState
readBuildState (ValueInt i) | i `elem` map fromEnum (enumFrom BuildBuilding) = toEnum i
readBuildState _ = error "invalid build state"
kojiGetBuildState :: String
-> BuildInfo
-> IO (Maybe BuildState)
kojiGetBuildState hubUrl buildinfo =
((fmap readBuildState . lookupStruct "state") =<<) <$>
getBuild hubUrl (buildInfo buildinfo)
data TaskState = TaskFree
| TaskOpen
| TaskClosed
| TaskCanceled
| TaskAssigned
| TaskFailed
deriving (Eq, Enum, Show)
openTaskStates :: [TaskState]
openTaskStates = [TaskFree, TaskOpen, TaskAssigned]
openTaskValues :: Value
openTaskValues = ValueArray $ map taskStateToValue openTaskStates
where
taskStateToValue :: TaskState -> Value
taskStateToValue = ValueInt . fromEnum
readTaskState :: Value -> TaskState
readTaskState (ValueInt i) | i `elem` map fromEnum (enumFrom TaskFree) = toEnum i
readTaskState _ = error "invalid task state"
getTaskState :: Struct -> Maybe TaskState
getTaskState st = readTaskState <$> lookup "state" st
kojiGetTaskState :: String
-> TaskID
-> IO (Maybe TaskState)
kojiGetTaskState hubUrl tid = do
mti <- getTaskInfo hubUrl (getID tid) False
return $ case mti of
Nothing -> Nothing
Just ti -> readTaskState <$> lookupStruct "state" ti
kojiGetTaskInfo :: String
-> TaskID
-> IO (Maybe Struct)
kojiGetTaskInfo hubUrl tid = getTaskInfo hubUrl (getID tid) True
kojiGetTaskChildren :: String
-> TaskID
-> Bool
-> IO [Struct]
kojiGetTaskChildren hubUrl tid =
getTaskChildren hubUrl (getID tid)
kojiLatestBuild :: String
-> String
-> String
-> IO (Maybe Struct)
kojiLatestBuild hubUrl tag pkg =
listToMaybe <$> getLatestBuilds hubUrl (InfoString tag) Nothing (Just pkg) Nothing
kojiLatestBuildRepo :: String
-> String
-> Int
-> String
-> IO (Maybe Struct)
kojiLatestBuildRepo hubUrl tag event pkg =
listToMaybe <$> getLatestBuilds hubUrl (InfoString tag) (Just event) (Just pkg) Nothing
data KojiBuild
= KojiBuild
{ kbBuildId :: Int
, kbPackageId :: Int
, kbOwnerName :: String
, kbNvr :: String
}
deriving (Show)
kojiListTaggedBuilds :: String
-> Bool
-> String
-> IO [KojiBuild]
kojiListTaggedBuilds hubUrl latest tag =
mapMaybe readKojiBuild <$> listTagged hubUrl tag Nothing False Nothing latest Nothing Nothing Nothing
where
readKojiBuild :: Struct -> Maybe KojiBuild
readKojiBuild values = do
buildId <- lookupStruct "build_id" values
packageId <- lookupStruct "package_id" values
owner <- lookupStruct "owner_name" values
nvr <- lookupStruct "nvr" values
return $ KojiBuild buildId packageId owner nvr
kojiBuildTarget :: String
-> String
-> IO (Maybe (String, String))
kojiBuildTarget hub target = do
mres <- maybeStruct <$> getBuildTarget hub target
case mres of
Nothing -> return Nothing
Just res -> return $ readTarget res
where
readTarget res = do
buildtag <- lookupStruct "build_tag_name" res
desttag <- lookupStruct "dest_tag_name" res
return (buildtag, desttag)
kojiListSideTags :: String
-> Maybe String
-> Maybe String
-> IO [String]
kojiListSideTags hub mbasetag muser =
mapMaybe (lookupStruct "name") . structArray <$> listSideTags hub (InfoString <$> mbasetag) (InfoString <$> muser)
data RepoState = RepoInit
| RepoReady
| RepoExpired
| RepoDeleted
| RepoProblem
deriving (Eq, Enum, Show)
readRepoState :: Value -> RepoState
readRepoState (ValueInt i) | i `elem` map fromEnum (enumFrom RepoInit) = toEnum i
readRepoState _ = error "invalid repo state"
kojiGetRepo :: String
-> String
-> Maybe RepoState
-> Maybe Int
-> IO (Maybe Struct)
kojiGetRepo hub tag mstate mevent =
maybeStruct <$> getRepo hub tag (fromEnum <$> mstate) mevent False
kojiGetCurrentRepo :: String -> String -> IO (Maybe Struct)
kojiGetCurrentRepo hub tag =
maybeStruct <$> getRepo hub tag Nothing Nothing False