{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module GitHub.Tools.Settings
  ( syncSettings
  , validateSettings
  ) where

import           Control.Monad                   (forM_, unless, when)
import           Data.Aeson                      (Value (Array, Object, String))
import qualified Data.Aeson.KeyMap               as KeyMap
import qualified Data.ByteString.Char8           as BS
import           Data.HashMap.Strict             (HashMap)
import qualified Data.HashMap.Strict             as HashMap
import           Data.List                       (isPrefixOf, nub, sortOn, (\\))
import           Data.Maybe                      (fromMaybe, mapMaybe)
import           Data.Text                       (Text)
import qualified Data.Text                       as Text
import qualified Data.Vector                     as V
import           Data.Yaml                       (encode)
import qualified GitHub
import qualified GitHub.Paths.Orgs               as Orgs
import qualified GitHub.Paths.Orgs.Teams         as Teams
import qualified GitHub.Paths.Orgs.Teams.Members as Members
import qualified GitHub.Paths.Repos              as Repos
import qualified GitHub.Paths.Repos.Branches     as Branches
import qualified GitHub.Paths.Repos.Labels       as Labels
import qualified GitHub.Paths.Repos.Rulesets     as Rulesets
import           GitHub.Tools.Requests           (mutate, mutate_, request)
import           GitHub.Types.Base.User          (User (..))
import           GitHub.Types.Settings           (Label (Label, labelName),
                                                  OrgSettings (..),
                                                  RepoSettings (..),
                                                  Ruleset (..), Team (..),
                                                  TeamMembership (..))
import           Network.HTTP.Client             (Manager, newManager)
import           Network.HTTP.Client.TLS         (tlsManagerSettings)

debug :: Bool
debug :: Bool
debug = Bool
False

delete :: Bool
delete :: Bool
delete = Bool
False

getRulesetId :: V.Vector Ruleset -> Text -> Maybe Int
getRulesetId :: Vector Ruleset -> Text -> Maybe Int
getRulesetId Vector Ruleset
rulesets Text
name = case (Ruleset -> Bool) -> Vector Ruleset -> Maybe Ruleset
forall a. (a -> Bool) -> Vector a -> Maybe a
V.find ((Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe Text -> Bool) -> (Ruleset -> Maybe Text) -> Ruleset -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ruleset -> Maybe Text
rulesetName) Vector Ruleset
rulesets of
  Just Ruleset{rulesetId :: Ruleset -> Maybe Int
rulesetId = Just Int
rId} -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
rId
  Maybe Ruleset
_                                  -> Maybe Int
forall a. Maybe a
Nothing

getTeamId :: V.Vector Team -> Text -> Maybe Int
getTeamId :: Vector Team -> Text -> Maybe Int
getTeamId Vector Team
teams Text
name = case (Team -> Bool) -> Vector Team -> Maybe Team
forall a. (a -> Bool) -> Vector a -> Maybe a
V.find ((Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Maybe Text -> Bool) -> (Team -> Maybe Text) -> Team -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Team -> Maybe Text
teamName) Vector Team
teams of
  Just Team{teamId :: Team -> Maybe Int
teamId = Just Int
tId} -> Int -> Maybe Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
tId
  Maybe Team
_                            -> Maybe Int
forall a. Maybe a
Nothing

syncSettings
  :: GitHub.Auth
  -> OrgSettings
  -> HashMap Text RepoSettings
  -> Text
  -> IO ()
syncSettings :: Auth -> OrgSettings -> HashMap Text RepoSettings -> Text -> IO ()
syncSettings Auth
auth OrgSettings
org HashMap Text RepoSettings
repos Text
repoFilter = do
  -- Initialise HTTP manager so we can benefit from keep-alive connections.
  Manager
mgr <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
  let orgLogin :: Text
orgLogin = OrgSettings -> Text
orgSettingsLogin OrgSettings
org

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text
repoFilter Text -> Text -> Bool
`Text.isPrefixOf` Text
orgLogin) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Auth -> Manager -> OrgSettings -> IO ()
syncOrgSettings Auth
auth Manager
mgr OrgSettings
org

  [(Text, RepoSettings)] -> ((Text, RepoSettings) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (((Text, RepoSettings) -> Text)
-> [(Text, RepoSettings)] -> [(Text, RepoSettings)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Text, RepoSettings) -> Text
forall a b. (a, b) -> a
fst ([(Text, RepoSettings)] -> [(Text, RepoSettings)])
-> (HashMap Text RepoSettings -> [(Text, RepoSettings)])
-> HashMap Text RepoSettings
-> [(Text, RepoSettings)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, RepoSettings)] -> [(Text, RepoSettings)]
forall b. [(Text, b)] -> [(Text, b)]
filterRepos ([(Text, RepoSettings)] -> [(Text, RepoSettings)])
-> (HashMap Text RepoSettings -> [(Text, RepoSettings)])
-> HashMap Text RepoSettings
-> [(Text, RepoSettings)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text RepoSettings -> [(Text, RepoSettings)]
forall a. HashMap Text a -> [(Text, a)]
each (HashMap Text RepoSettings -> [(Text, RepoSettings)])
-> HashMap Text RepoSettings -> [(Text, RepoSettings)]
forall a b. (a -> b) -> a -> b
$ HashMap Text RepoSettings
repos) (((Text, RepoSettings) -> IO ()) -> IO ())
-> ((Text, RepoSettings) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Text
repo, RepoSettings
repoSettings) -> do
    Auth -> Manager -> Text -> Text -> RepoSettings -> IO ()
syncRepoSettings Auth
auth Manager
mgr Text
orgLogin Text
repo RepoSettings
repoSettings
  where
    filterRepos :: [(Text, b)] -> [(Text, b)]
filterRepos = ((Text, b) -> Bool) -> [(Text, b)] -> [(Text, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Text
repoFilter Text -> Text -> Bool
`Text.isPrefixOf`) (Text -> Bool) -> ((Text, b) -> Text) -> (Text, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, b) -> Text
forall a b. (a, b) -> a
fst)


syncOrgSettings :: GitHub.Auth -> Manager -> OrgSettings -> IO ()
syncOrgSettings :: Auth -> Manager -> OrgSettings -> IO ()
syncOrgSettings Auth
auth Manager
mgr OrgSettings{Text
HashMap Text Team
Value
orgSettingsTeams :: OrgSettings -> HashMap Text Team
orgSettingsEditOrg :: OrgSettings -> Value
orgSettingsTeams :: HashMap Text Team
orgSettingsLogin :: Text
orgSettingsEditOrg :: Value
orgSettingsLogin :: OrgSettings -> Text
..} = do
  Value
editRes <- Auth -> Manager -> Request 'RW Value -> IO Value
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text -> Value -> Request 'RW Value
Orgs.editOrgR Text
orgSettingsLogin Value
orgSettingsEditOrg)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
editRes
  Auth -> Manager -> Text -> HashMap Text Team -> IO ()
syncOrgTeams Auth
auth Manager
mgr Text
orgSettingsLogin HashMap Text Team
orgSettingsTeams


syncOrgTeams :: GitHub.Auth -> Manager -> Text -> HashMap Text Team -> IO ()
syncOrgTeams :: Auth -> Manager -> Text -> HashMap Text Team -> IO ()
syncOrgTeams Auth
auth Manager
mgr Text
orgLogin HashMap Text Team
orgTeams = do
  Vector Team
teams <- Maybe Auth
-> Manager -> Request 'RO (Vector Team) -> IO (Vector Team)
forall a.
FromJSON a =>
Maybe Auth -> Manager -> Request 'RO a -> IO a
request (Auth -> Maybe Auth
forall a. a -> Maybe a
Just Auth
auth) Manager
mgr (Text -> Request 'RO (Vector Team)
Teams.getTeamsR Text
orgLogin)
  [(Text, Team)] -> ((Text, Team) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap Text Team -> [(Text, Team)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Team
orgTeams) (((Text, Team) -> IO ()) -> IO ())
-> ((Text, Team) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Text
name, Team
team) -> do
    let namedTeam :: Team
namedTeam = Team
team
          { teamName :: Maybe Text
teamName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name
          , teamParentTeamId :: Maybe Int
teamParentTeamId = Team -> Maybe Team
teamParent Team
team Maybe Team -> (Team -> Maybe Text) -> Maybe Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Team -> Maybe Text
teamName Maybe Text -> (Text -> Maybe Int) -> Maybe Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Vector Team -> Text -> Maybe Int
getTeamId Vector Team
teams
          , teamMembers :: Maybe (HashMap Text Text)
teamMembers = Maybe (HashMap Text Text)
forall a. Maybe a
Nothing  -- Synced later.
          }
    Value
teamRes <- case Vector Team -> Text -> Maybe Int
getTeamId Vector Team
teams Text
name of
      Just{}  -> Auth -> Manager -> Request 'RW Value -> IO Value
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text -> Text -> Team -> Request 'RW Value
Teams.updateTeamR Text
orgLogin Text
name Team
namedTeam)
      Maybe Int
Nothing -> do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Creating team " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
name
        Auth -> Manager -> Request 'RW Value -> IO Value
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text -> Team -> Request 'RW Value
Teams.createTeamR Text
orgLogin Team
namedTeam)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
teamRes
    Maybe (HashMap Text Text) -> (HashMap Text Text -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Team -> Maybe (HashMap Text Text)
teamMembers Team
team) ((HashMap Text Text -> IO ()) -> IO ())
-> (HashMap Text Text -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ Auth -> Manager -> Text -> Text -> HashMap Text Text -> IO ()
syncTeamMembers Auth
auth Manager
mgr Text
orgLogin Text
name


syncTeamMembers :: GitHub.Auth -> Manager -> Text -> Text -> HashMap Text Text -> IO ()
syncTeamMembers :: Auth -> Manager -> Text -> Text -> HashMap Text Text -> IO ()
syncTeamMembers Auth
auth Manager
mgr Text
orgLogin Text
team HashMap Text Text
teamMembers = do
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Syncing team members to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
orgLogin String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
team
  Vector User
currentMembers <- Maybe Auth
-> Manager -> Request 'RO (Vector User) -> IO (Vector User)
forall a.
FromJSON a =>
Maybe Auth -> Manager -> Request 'RO a -> IO a
request (Auth -> Maybe Auth
forall a. a -> Maybe a
Just Auth
auth) Manager
mgr (Text -> Text -> Request 'RO (Vector User)
Members.getMembersR Text
orgLogin Text
team)
  -- Remove members that are not in the settings.
  [User] -> (User -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Vector User -> [User]
forall a. Vector a -> [a]
V.toList Vector User
currentMembers) ((User -> IO ()) -> IO ()) -> (User -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \User{Text
userLogin :: User -> Text
userLogin :: Text
userLogin} ->
    case Text -> HashMap Text Text -> Maybe Text
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
userLogin HashMap Text Text
teamMembers of
      Maybe Text
Nothing -> do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Removing team member " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
userLogin String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" from " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
team
        -- mutate_ auth mgr (Members.deleteMemberR orgLogin team userLogin)
      Just{} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Add members that are in the settings but not in the team.
  [(Text, Text)] -> ((Text, Text) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap Text Text -> [(Text, Text)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Text
teamMembers) (((Text, Text) -> IO ()) -> IO ())
-> ((Text, Text) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Text
login, Text
role) ->
    case (User -> Bool) -> Vector User -> Maybe User
forall a. (a -> Bool) -> Vector a -> Maybe a
V.find ((Text
login Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool) -> (User -> Text) -> User -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Text
userLogin) Vector User
currentMembers of
      Maybe User
Nothing -> do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Adding team " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
role String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
login String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
team
        TeamMembership
res <- Auth -> Manager -> Request 'RW TeamMembership -> IO TeamMembership
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text
-> Text -> Text -> TeamMembership -> Request 'RW TeamMembership
Members.addMemberR Text
orgLogin Text
team Text
login (Text -> TeamMembership
TeamMembership Text
role))
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ TeamMembership -> ByteString
forall a. ToJSON a => a -> ByteString
encode TeamMembership
res
      Just{} -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  -- Update roles of existing members if necessary.
  [(Text, Text)] -> ((Text, Text) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (HashMap Text Text -> [(Text, Text)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Text
teamMembers) (((Text, Text) -> IO ()) -> IO ())
-> ((Text, Text) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Text
login, Text
role) -> do
    TeamMembership
currentMembership <- Maybe Auth
-> Manager -> Request 'RO TeamMembership -> IO TeamMembership
forall a.
FromJSON a =>
Maybe Auth -> Manager -> Request 'RO a -> IO a
request (Auth -> Maybe Auth
forall a. a -> Maybe a
Just Auth
auth) Manager
mgr (Text -> Text -> Text -> Request 'RO TeamMembership
Members.getMembershipR Text
orgLogin Text
team Text
login)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (TeamMembership -> Text
teamMembershipRole TeamMembership
currentMembership Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= Text
role) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
      String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Setting team member " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
login String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" role for team " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
team String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
role
      TeamMembership
res <- Auth -> Manager -> Request 'RW TeamMembership -> IO TeamMembership
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text
-> Text -> Text -> TeamMembership -> Request 'RW TeamMembership
Members.addMemberR Text
orgLogin Text
team Text
login (Text -> TeamMembership
TeamMembership Text
role))
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ TeamMembership -> ByteString
forall a. ToJSON a => a -> ByteString
encode TeamMembership
res


syncRepoSettings :: GitHub.Auth -> Manager -> Text -> Text -> RepoSettings -> IO ()
syncRepoSettings :: Auth -> Manager -> Text -> Text -> RepoSettings -> IO ()
syncRepoSettings Auth
auth Manager
mgr Text
orgLogin Text
repo RepoSettings{Maybe (HashMap Text Value)
Maybe (HashMap Text Ruleset)
HashMap Text Label
Value
repoSettingsLabels :: RepoSettings -> HashMap Text Label
repoSettingsRulesets :: RepoSettings -> Maybe (HashMap Text Ruleset)
repoSettingsBranches :: RepoSettings -> Maybe (HashMap Text Value)
repoSettingsEditRepo :: RepoSettings -> Value
repoSettingsLabels :: HashMap Text Label
repoSettingsRulesets :: Maybe (HashMap Text Ruleset)
repoSettingsBranches :: Maybe (HashMap Text Value)
repoSettingsEditRepo :: Value
..} = do
  Value
editRes <- Auth -> Manager -> Request 'RW Value -> IO Value
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text -> Text -> Value -> Request 'RW Value
Repos.editRepoR Text
orgLogin Text
repo Value
repoSettingsEditRepo)
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
editRes
  Auth -> Manager -> Text -> Text -> HashMap Text Label -> IO ()
syncLabels Auth
auth Manager
mgr Text
orgLogin Text
repo HashMap Text Label
repoSettingsLabels
  [(Text, Value)] -> ((Text, Value) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(Text, Value)]
-> (HashMap Text Value -> [(Text, Value)])
-> Maybe (HashMap Text Value)
-> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] HashMap Text Value -> [(Text, Value)]
forall a. HashMap Text a -> [(Text, a)]
each Maybe (HashMap Text Value)
repoSettingsBranches) (((Text, Value) -> IO ()) -> IO ())
-> ((Text, Value) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Text
branch, Value
update) -> do
    Value
protRes <- Auth -> Manager -> Request 'RW Value -> IO Value
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text -> Text -> Text -> Value -> Request 'RW Value
Branches.addProtectionR Text
orgLogin Text
repo Text
branch Value
update)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
protRes
  Auth
-> Manager -> Text -> Text -> Maybe (HashMap Text Ruleset) -> IO ()
syncRepoRulesets Auth
auth Manager
mgr Text
orgLogin Text
repo Maybe (HashMap Text Ruleset)
repoSettingsRulesets


syncRepoRulesets :: GitHub.Auth -> Manager -> Text -> Text -> Maybe (HashMap Text Ruleset) -> IO ()
syncRepoRulesets :: Auth
-> Manager -> Text -> Text -> Maybe (HashMap Text Ruleset) -> IO ()
syncRepoRulesets Auth
auth Manager
mgr Text
orgLogin Text
repo Maybe (HashMap Text Ruleset)
repoRulesets = do
  Vector Ruleset
rulesets <- Maybe Auth
-> Manager -> Request 'RO (Vector Ruleset) -> IO (Vector Ruleset)
forall a.
FromJSON a =>
Maybe Auth -> Manager -> Request 'RO a -> IO a
request (Auth -> Maybe Auth
forall a. a -> Maybe a
Just Auth
auth) Manager
mgr (Text -> Text -> Request 'RO (Vector Ruleset)
Rulesets.getRulesetsR Text
orgLogin Text
repo)
  [(Text, Ruleset)] -> ((Text, Ruleset) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(Text, Ruleset)]
-> (HashMap Text Ruleset -> [(Text, Ruleset)])
-> Maybe (HashMap Text Ruleset)
-> [(Text, Ruleset)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] HashMap Text Ruleset -> [(Text, Ruleset)]
forall a. HashMap Text a -> [(Text, a)]
each Maybe (HashMap Text Ruleset)
repoRulesets) (((Text, Ruleset) -> IO ()) -> IO ())
-> ((Text, Ruleset) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Text
name, Ruleset
ruleset) -> do
    let namedRuleset :: Ruleset
namedRuleset = Ruleset
ruleset{rulesetName :: Maybe Text
rulesetName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name}
    Value
rulesetRes <- case Vector Ruleset -> Text -> Maybe Int
getRulesetId Vector Ruleset
rulesets Text
name of
      Just Int
rId -> Auth -> Manager -> Request 'RW Value -> IO Value
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text -> Text -> Int -> Ruleset -> Request 'RW Value
Rulesets.updateRulesetR Text
orgLogin Text
repo Int
rId Ruleset
namedRuleset)
      Maybe Int
Nothing  -> Auth -> Manager -> Request 'RW Value -> IO Value
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text -> Text -> Ruleset -> Request 'RW Value
Rulesets.addRulesetR Text
orgLogin Text
repo Ruleset
namedRuleset)
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
debug (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode Value
rulesetRes


syncLabels :: GitHub.Auth -> Manager -> Text -> Text -> HashMap Text Label -> IO ()
syncLabels :: Auth -> Manager -> Text -> Text -> HashMap Text Label -> IO ()
syncLabels Auth
auth Manager
mgr Text
orgLogin Text
repo HashMap Text Label
labels = do
  String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Syncing labels to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
repo
  let newLabels :: [(Text, Label)]
newLabels = [(Text, Label)] -> [(Text, Label)]
forall a. Eq a => [a] -> [a]
nub ([(Text, Label)] -> [(Text, Label)])
-> (HashMap Text Label -> [(Text, Label)])
-> HashMap Text Label
-> [(Text, Label)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Label) -> (Text, Label))
-> [(Text, Label)] -> [(Text, Label)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
name, Label
label) -> (Text
name, Label
label{labelName :: Maybe Text
labelName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name})) ([(Text, Label)] -> [(Text, Label)])
-> (HashMap Text Label -> [(Text, Label)])
-> HashMap Text Label
-> [(Text, Label)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Label -> [(Text, Label)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap Text Label -> [(Text, Label)])
-> HashMap Text Label -> [(Text, Label)]
forall a b. (a -> b) -> a -> b
$ HashMap Text Label
labels
  [(Text, Label)]
oldLabels <- [(Text, Label)] -> [(Text, Label)]
forall a. Eq a => [a] -> [a]
nub ([(Text, Label)] -> [(Text, Label)])
-> (Vector Label -> [(Text, Label)])
-> Vector Label
-> [(Text, Label)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Label -> (Text, Label)) -> [Label] -> [(Text, Label)]
forall a b. (a -> b) -> [a] -> [b]
map (\label :: Label
label@Label{Maybe Text
labelName :: Maybe Text
labelName :: Label -> Maybe Text
labelName} -> (Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
"" Maybe Text
labelName, Label
label)) ([Label] -> [(Text, Label)])
-> (Vector Label -> [Label]) -> Vector Label -> [(Text, Label)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Label -> [Label]
forall a. Vector a -> [a]
V.toList
    (Vector Label -> [(Text, Label)])
-> IO (Vector Label) -> IO [(Text, Label)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Auth
-> Manager -> Request 'RO (Vector Label) -> IO (Vector Label)
forall a.
FromJSON a =>
Maybe Auth -> Manager -> Request 'RO a -> IO a
request (Auth -> Maybe Auth
forall a. a -> Maybe a
Just Auth
auth) Manager
mgr (Text -> Text -> Request 'RO (Vector Label)
Labels.getLabelsR Text
orgLogin Text
repo)
  [(Text, Label)] -> ((Text, Label) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(Text, Label)]
oldLabels [(Text, Label)] -> [(Text, Label)] -> [(Text, Label)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Text, Label)]
newLabels) (((Text, Label) -> IO ()) -> IO ())
-> ((Text, Label) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Text
lblName, Label
lbl) -> do
    if Bool
delete
      then do
        String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"DELETING old label: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Label -> String
forall a. Show a => a -> String
show Label
lbl
        Auth -> Manager -> GenRequest 'MtUnit 'RW () -> IO ()
mutate_ Auth
auth Manager
mgr (Text -> Text -> Text -> GenRequest 'MtUnit 'RW ()
Labels.deleteLabelR Text
orgLogin Text
repo Text
lblName)
      else String -> IO ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"NOT deleting old label: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Label -> String
forall a. Show a => a -> String
show Label
lbl
  [(Text, Label)] -> ((Text, Label) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(Text, Label)]
newLabels [(Text, Label)] -> [(Text, Label)] -> [(Text, Label)]
forall a. Eq a => [a] -> [a] -> [a]
\\ [(Text, Label)]
oldLabels) (((Text, Label) -> IO ()) -> IO ())
-> ((Text, Label) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Text
lblName, Label
lbl) -> do
    Label -> IO ()
forall a. Show a => a -> IO ()
print Label
lbl
    Label
res <- if ((Text, Label) -> Bool) -> [(Text, Label)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Text
lblName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==) (Text -> Bool) -> ((Text, Label) -> Text) -> (Text, Label) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, Label) -> Text
forall a b. (a, b) -> a
fst) [(Text, Label)]
oldLabels
      then Auth -> Manager -> Request 'RW Label -> IO Label
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text -> Text -> Text -> Label -> Request 'RW Label
Labels.updateLabelR Text
orgLogin Text
repo Text
lblName Label
lbl)
      else Auth -> Manager -> Request 'RW Label -> IO Label
forall a. FromJSON a => Auth -> Manager -> Request 'RW a -> IO a
mutate Auth
auth Manager
mgr (Text -> Text -> Label -> Request 'RW Label
Labels.createLabelR Text
orgLogin Text
repo Label
lbl)
    ByteString -> IO ()
BS.putStrLn (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Label -> ByteString
forall a. ToJSON a => a -> ByteString
encode Label
res


validateSettings :: MonadFail m => HashMap Text RepoSettings -> m ()
validateSettings :: HashMap Text RepoSettings -> m ()
validateSettings HashMap Text RepoSettings
repos = do
  HashMap Text Value
commonBranches <- case Text -> HashMap Text RepoSettings -> Maybe RepoSettings
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"_common" HashMap Text RepoSettings
repos Maybe RepoSettings
-> (RepoSettings -> Maybe (HashMap Text Value))
-> Maybe (HashMap Text Value)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RepoSettings -> Maybe (HashMap Text Value)
repoSettingsBranches of
    Maybe (HashMap Text Value)
Nothing -> String -> m (HashMap Text Value)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no _common section found"
    Just HashMap Text Value
ok -> HashMap Text Value -> m (HashMap Text Value)
forall (m :: * -> *) a. Monad m => a -> m a
return HashMap Text Value
ok
  [Text]
commonContexts <- case Text -> HashMap Text Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
"master" HashMap Text Value
commonBranches of
    Maybe Value
Nothing -> String -> m [Text]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no \"master\" branch in _common section found"
    Just Value
ok -> Text -> Text -> Value -> m [Text]
forall (m :: * -> *).
MonadFail m =>
Text -> Text -> Value -> m [Text]
getContexts Text
"_common" Text
"master" (Value -> m [Text]) -> m Value -> m [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Value -> m Value
forall (m :: * -> *).
MonadFail m =>
Text -> Text -> Value -> m Value
getRequiredStatusChecks Text
"_common" Text
"master" Value
ok
  -- Check that each repo's branch protection contexts start with the common ones.
  [(Text, RepoSettings)] -> ((Text, RepoSettings) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(Text, RepoSettings)] -> [(Text, RepoSettings)]
forall b. [(Text, b)] -> [(Text, b)]
filterRepos ([(Text, RepoSettings)] -> [(Text, RepoSettings)])
-> (HashMap Text RepoSettings -> [(Text, RepoSettings)])
-> HashMap Text RepoSettings
-> [(Text, RepoSettings)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text RepoSettings -> [(Text, RepoSettings)]
forall a. HashMap Text a -> [(Text, a)]
each (HashMap Text RepoSettings -> [(Text, RepoSettings)])
-> HashMap Text RepoSettings -> [(Text, RepoSettings)]
forall a b. (a -> b) -> a -> b
$ HashMap Text RepoSettings
repos) (((Text, RepoSettings) -> m ()) -> m ())
-> ((Text, RepoSettings) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Text
repo, RepoSettings{Maybe (HashMap Text Value)
Maybe (HashMap Text Ruleset)
HashMap Text Label
Value
repoSettingsLabels :: HashMap Text Label
repoSettingsRulesets :: Maybe (HashMap Text Ruleset)
repoSettingsBranches :: Maybe (HashMap Text Value)
repoSettingsEditRepo :: Value
repoSettingsLabels :: RepoSettings -> HashMap Text Label
repoSettingsRulesets :: RepoSettings -> Maybe (HashMap Text Ruleset)
repoSettingsBranches :: RepoSettings -> Maybe (HashMap Text Value)
repoSettingsEditRepo :: RepoSettings -> Value
..}) ->
    [(Text, Value)] -> ((Text, Value) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([(Text, Value)]
-> (HashMap Text Value -> [(Text, Value)])
-> Maybe (HashMap Text Value)
-> [(Text, Value)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] HashMap Text Value -> [(Text, Value)]
forall a. HashMap Text a -> [(Text, a)]
each Maybe (HashMap Text Value)
repoSettingsBranches) (((Text, Value) -> m ()) -> m ())
-> ((Text, Value) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Text
branch, Value
update) -> do
      [Text]
contexts <- Text -> Text -> Value -> m [Text]
forall (m :: * -> *).
MonadFail m =>
Text -> Text -> Value -> m [Text]
getContexts Text
repo Text
branch (Value -> m [Text]) -> m Value -> m [Text]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Text -> Text -> Value -> m Value
forall (m :: * -> *).
MonadFail m =>
Text -> Text -> Value -> m Value
getRequiredStatusChecks Text
repo Text
branch Value
update
      let ctx :: Text
ctx = Text
repo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".branches." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".required_status_checks.contexts"
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text]
commonContexts [Text] -> [Text] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` [Text]
contexts) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> (Text -> String) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
ctx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" should start with " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack ([Text] -> String
forall a. Show a => a -> String
show [Text]
commonContexts)
      let dups :: [Text]
dups = [Text]
contexts [Text] -> [Text] -> [Text]
forall a. Eq a => [a] -> [a] -> [a]
\\ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
contexts
      Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
dups) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
        String -> m ()
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m ()) -> (Text -> String) -> Text -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
ctx Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" has duplicates: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack ([Text] -> String
forall a. Show a => a -> String
show [Text]
dups)

  where
    filterRepos :: [(Text, b)] -> [(Text, b)]
filterRepos = ((Text, b) -> Bool) -> [(Text, b)] -> [(Text, b)]
forall a. (a -> Bool) -> [a] -> [a]
filter (((Text, b) -> Bool) -> [(Text, b)] -> [(Text, b)])
-> ((Text, b) -> Bool) -> [(Text, b)] -> [(Text, b)]
forall a b. (a -> b) -> a -> b
$ (Text
"experimental" Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/=) (Text -> Bool) -> ((Text, b) -> Text) -> (Text, b) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text, b) -> Text
forall a b. (a, b) -> a
fst
    getRequiredStatusChecks :: Text -> Text -> Value -> m Value
getRequiredStatusChecks Text
repo Text
branch (Object Object
mems) =
      case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"required_status_checks" Object
mems of
        Maybe Value
Nothing -> String -> m Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Value) -> (Text -> String) -> Text -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> m Value) -> Text -> m Value
forall a b. (a -> b) -> a -> b
$ Text
repo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".branches." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" should contain required_status_checks"
        Just Value
ok -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
ok
    getRequiredStatusChecks Text
repo Text
branch Value
_ =
      String -> m Value
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Value) -> (Text -> String) -> Text -> m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> m Value) -> Text -> m Value
forall a b. (a -> b) -> a -> b
$ Text
repo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".branches." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" should be an object"

    getContexts :: Text -> Text -> Value -> m [Text]
getContexts Text
repo Text
branch (Object Object
mems) =
      case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
KeyMap.lookup Key
"contexts" Object
mems of
        Just (Array Array
arr) -> [Text] -> m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ (Value -> Maybe Text) -> [Value] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Value -> Maybe Text
toString ([Value] -> [Text]) -> [Value] -> [Text]
forall a b. (a -> b) -> a -> b
$ Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
arr
        Just Value
_ -> String -> m [Text]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m [Text]) -> (Text -> String) -> Text -> m [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> m [Text]) -> Text -> m [Text]
forall a b. (a -> b) -> a -> b
$ Text
repo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".branches." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".required_status_checks.contexts should be an array"
        Maybe Value
Nothing -> String -> m [Text]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m [Text]) -> (Text -> String) -> Text -> m [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> m [Text]) -> Text -> m [Text]
forall a b. (a -> b) -> a -> b
$ Text
repo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".branches." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".required_status_checks should contain contexts"
    getContexts Text
repo Text
branch Value
_ =
      String -> m [Text]
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m [Text]) -> (Text -> String) -> Text -> m [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> m [Text]) -> Text -> m [Text]
forall a b. (a -> b) -> a -> b
$ Text
repo Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".branches." Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
branch Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".required_status_checks should be an object"

    toString :: Value -> Maybe Text
toString (String Text
str) = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
str
    toString Value
_            = Maybe Text
forall a. Maybe a
Nothing

each :: HashMap Text a -> [(Text, a)]
each :: HashMap Text a -> [(Text, a)]
each = HashMap Text a -> [(Text, a)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList (HashMap Text a -> [(Text, a)])
-> (HashMap Text a -> HashMap Text a)
-> HashMap Text a
-> [(Text, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> a -> Bool) -> HashMap Text a -> HashMap Text a
forall k v. (k -> v -> Bool) -> HashMap k v -> HashMap k v
HashMap.filterWithKey (\Text
k a
_ -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Text
"_" Text -> Text -> Bool
`Text.isPrefixOf` Text
k)