{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : GitLab.SystemHooks.GitLabSystemHooks
-- Description : Haskell records corresponding to JSON data from GitLab system hooks
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2020
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.SystemHooks.GitLabSystemHooks
  ( receive,
    receiveString,
    tryFire,
  )
where

import qualified Control.Exception as E
import Control.Monad
import Control.Monad.IO.Class
import qualified Control.Monad.Reader as MR
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Typeable
import GitLab.SystemHooks.Types
import GitLab.Types
import System.IO.Temp
import System.Posix.Files

-- | Attempts to fire each rule in sequence. Reads the JSON data
-- received from the GitLab server from standard input.
receive :: [Rule] -> GitLab ()
receive :: [Rule] -> GitLab ()
receive [Rule]
rules = do
  Text
eventContent <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Text
TIO.getContents
  Text -> [Rule] -> GitLab ()
receiveString Text
eventContent [Rule]
rules

-- | Attempts to fire each rule in sequence. Reads the JSON data
-- received from a function argument.
receiveString :: Text -> [Rule] -> GitLab ()
receiveString :: Text -> [Rule] -> GitLab ()
receiveString Text
eventContent [Rule]
rules = do
  Text -> GitLab ()
traceSystemHook Text
eventContent
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Text -> Rule -> GitLab ()
fire Text
eventContent) [Rule]
rules

traceSystemHook :: Text -> GitLab ()
traceSystemHook :: Text -> GitLab ()
traceSystemHook Text
eventContent = do
  GitLabServerConfig
cfg <- GitLabState -> GitLabServerConfig
serverCfg forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *). MonadReader r m => m r
MR.ask
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
E.catch
      ( forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GitLabServerConfig -> Bool
debugSystemHooks GitLabServerConfig
cfg) forall a b. (a -> b) -> a -> b
$ do
          String
fpath <- String -> String -> IO String
writeSystemTempFile String
"gitlab-system-hook-" (Text -> String
T.unpack Text
eventContent)
          forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String -> FileMode -> IO ()
setFileMode String
fpath FileMode
otherReadMode
      )
      -- runGitLabDbg must have been used, which doesn't define a GitLabServerConfig
      (\(ErrorCall
_exception :: E.ErrorCall) -> forall (m :: * -> *) a. Monad m => a -> m a
return ())

orElse :: GitLab Bool -> GitLab Bool -> GitLab Bool
orElse :: GitLab Bool -> GitLab Bool -> GitLab Bool
orElse GitLab Bool
f GitLab Bool
g = do
  Bool
x <- GitLab Bool
f
  if Bool
x
    then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
    else GitLab Bool
g

fire :: Text -> Rule -> GitLab ()
fire :: Text -> Rule -> GitLab ()
fire Text
contents Rule
rule = do
  Bool
result <- Text -> Rule -> GitLab Bool
tryFire Text
contents Rule
rule
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
result forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn (String
"fired: " forall a. Semigroup a => a -> a -> a
<> Rule -> String
labelOf Rule
rule))
  where
    labelOf :: Rule -> String
    labelOf :: Rule -> String
labelOf (Match String
lbl a -> GitLab ()
_) = String
lbl
    labelOf (MatchIf String
lbl a -> GitLab Bool
_ a -> GitLab ()
_) = String
lbl

-- | Try to fire a GitLab rule, returns 'True' if the rule fired and
-- 'False' if it did not fire.
tryFire :: Text -> Rule -> GitLab Bool
tryFire :: Text -> Rule -> GitLab Bool
tryFire Text
contents (Match String
_ a -> GitLab ()
f) = do
  forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
    (forall a. a -> Maybe a
Just (\ProjectCreate
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
    (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectCreate -> GitLab ()))
    (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe ProjectCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\ProjectDestroy
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectDestroy -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe ProjectDestroy)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\ProjectRename
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectRename -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe ProjectRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\ProjectTransfer
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectTransfer -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe ProjectTransfer)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\ProjectUpdate
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectUpdate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe ProjectUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\GroupMemberUpdate
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupMemberUpdate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe GroupMemberUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\UserAddToTeam
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserAddToTeam -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserAddToTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\UserUpdateForTeam
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserUpdateForTeam -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserUpdateForTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\UserRemoveFromTeam
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRemoveFromTeam -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserRemoveFromTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\UserCreate
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserCreate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\UserRemove
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRemove -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\UserFailedLogin
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserFailedLogin -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserFailedLogin)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\UserRename
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRename -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\KeyCreate
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (KeyCreate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe KeyCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\KeyRemove
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (KeyRemove -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe KeyRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\GroupCreate
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupCreate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe GroupCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\GroupRemove
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupRemove -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe GroupRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\GroupRename
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupRename -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe GroupRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\NewGroupMember
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (NewGroupMember -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe NewGroupMember)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\GroupMemberRemove
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupMemberRemove -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe GroupMemberRemove)
    -- `orElse` fireIf'
    --   (Just (\_ -> return True))
    --   (cast f :: Maybe (ProjectEvent -> GitLab ()))
    --   (parseEvent contents :: Maybe ProjectEvent)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\Push
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (Push -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe Push)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\TagPush
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (TagPush -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe TagPush)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\RepositoryUpdate
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (RepositoryUpdate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe RepositoryUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a. a -> Maybe a
Just (\MergeRequestEvent
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (MergeRequestEvent -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe MergeRequestEvent)
tryFire Text
contents (MatchIf String
_ a -> GitLab Bool
predF a -> GitLab ()
f) = do
  forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
    (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (ProjectCreate -> GitLab Bool))
    (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectCreate -> GitLab ()))
    (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe ProjectCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (ProjectDestroy -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectDestroy -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe ProjectDestroy)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (ProjectRename -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectRename -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe ProjectRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (ProjectTransfer -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectTransfer -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe ProjectTransfer)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (ProjectUpdate -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (ProjectUpdate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe ProjectUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (GroupMemberUpdate -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupMemberUpdate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe GroupMemberUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserAddToTeam -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserAddToTeam -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserAddToTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserUpdateForTeam -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserUpdateForTeam -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserUpdateForTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserRemoveFromTeam -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRemoveFromTeam -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserRemoveFromTeam)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserCreate -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserCreate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserRemove -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRemove -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserFailedLogin -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserFailedLogin -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserFailedLogin)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (UserRename -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (UserRename -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe UserRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (KeyCreate -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (KeyCreate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe KeyCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (KeyRemove -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (KeyRemove -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe KeyRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (GroupCreate -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupCreate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe GroupCreate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (GroupRemove -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupRemove -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe GroupRemove)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (GroupRename -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupRename -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe GroupRename)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (NewGroupMember -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (NewGroupMember -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe NewGroupMember)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (GroupMemberRemove -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (GroupMemberRemove -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe GroupMemberRemove)
    -- `orElse` fireIf'
    --   (cast predF :: Maybe (ProjectEvent -> GitLab Bool))
    --   (cast f :: Maybe (ProjectEvent -> GitLab ()))
    --   (parseEvent contents :: Maybe ProjectEvent)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (Push -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (Push -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe Push)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (TagPush -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (TagPush -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe TagPush)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (RepositoryUpdate -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (RepositoryUpdate -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe RepositoryUpdate)
    GitLab Bool -> GitLab Bool -> GitLab Bool
`orElse` forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf'
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab Bool
predF :: Maybe (MergeRequestEvent -> GitLab Bool))
      (forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast a -> GitLab ()
f :: Maybe (MergeRequestEvent -> GitLab ()))
      (forall a. FromJSON a => Text -> Maybe a
parseEvent Text
contents :: Maybe MergeRequestEvent)

fireIf' :: (Typeable a, Show a) => Maybe (a -> GitLab Bool) -> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf' :: forall a.
(Typeable a, Show a) =>
Maybe (a -> GitLab Bool)
-> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool
fireIf' Maybe (a -> GitLab Bool)
castPred Maybe (a -> GitLab ())
castF Maybe a
parsed = do
  case Maybe (a -> GitLab Bool)
castPred of
    Maybe (a -> GitLab Bool)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    Just a -> GitLab Bool
pred' ->
      case Maybe (a -> GitLab ())
castF of
        Maybe (a -> GitLab ())
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just a -> GitLab ()
f' ->
          case Maybe a
parsed of
            Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            Just a
parsed' -> do
              Bool
testPred <- a -> GitLab Bool
pred' a
parsed'
              if Bool
testPred
                then do
                  a -> GitLab ()
f' a
parsed'
                  forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                else forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False