Shestakov Alex Blog People membership validation in JIRA fields against Active Directory

Current version of JIRA inside Itransition does not allow to validate “whether a person belongs to a certain group” for multi-people fields, only for single-user fields. Coorish – is a small utility to determine ineligible people being specified in JIRA tickets.

History

Project card – is a custom JIRA ticket, containing a bunch of fields about the project (I do work in an outsource company, so…) – technologies used, people involved, plans and troubles, etc. Since migration plans are far away, I decided to write a small utility to ensure that there are no “misuses” – only people from Project.Management.All AD group are specified in “Project Manager” fields in project cards.

Internals

So it is a small terminal application, which “talks” to JIRA asking about project cards, “talks” to AD via LDAP to get members of the groups and spills the results to the terminal.

main :: IO ()
main = do
  Config {..} <- readConfig @Config
  ldapConfig <- readConfig @Ldap.LdapConfig
  jiraConfig <- readConfig @Jira.JiraConfig

  activeDirectoryPeople <- Ldap.groupMembers ldapGroups ldapConfig
  projectCards <- Jira.projectCards jiraField jiraConfig

  forM_ projectCards $ \card -> do
    let people = Jira.people card
    when (null people) $ pure ()

    let (validPeople, invalidPeople) = partition (\person -> Jira.displayName person `elem` activeDirectoryPeople) people

    unless (null invalidPeople) $ do
      putTextLn $
        "Card '" <> Jira.projectName card <> "' (" <> Jira.key card <> ") "
          <> "has some people in '"
          <> jiraField
          <> "' field not from '"
          <> mconcat (intersperse "; " ldapGroups)
          <> "' AD group: '"
          <> mconcat (intersperse "; " (map Jira.displayName invalidPeople))
          <> "'"

I used the same ldap-client library for LDAP communication, but this time utilized text-ldap for parsing DNs from ldap into proper data structures instead of treating results like strings. Envy library with some sprinkles of template-haskell magic allowed me to read configuration properties from environment variables. Servant-client again proved to be very handy to “talk” to the external HTTP API. Template haskell was used for one more thing – embedding configuration values into FromJSON instances – I didn’t know how to parametrize them in an elegant way.

data Config = Config
   { jiraField :: Text,
     ldapGroups :: [Text]
   }
   deriving (Generic, Show)

configValue :: Lift t => (Config -> t) -> Q Exp
 configValue f = do
   groups <- runIO (f <$> readConfig @Config)
   [e|groups|]

instance FromJSON ProjectCard where
   parseJSON = withObject "card" $ \card -> do
     key <- card .: "key"
     fields <- card .: "fields"
     projectName <- fields .: "summary"
     peopleMaybe <- fields .:? $(configValue jiraField) <|> fmap (replicate 1) <$> fields .:? $(configValue jiraField)
     pure $ ProjectCard key projectName $ fromMaybe [] peopleMaybe

Well, now I know, the trick is to make FromJSON instance for a function).

instance FromJSON (Text -> ProjectCard) where
  parseJSON = withObject "card" $ \card -> do
    key <- card .: "key"
    fields <- card .: "fields"
    projectName <- fields .: "summary"
    allPossiblePeople <- M.fromList <$> mapM parser (HM.toList fields)
    pure $ \feild -> ProjectCard key projectName $ fromMaybe [] $ join $ lookup feild allPossiblePeople

parser :: FromJSON a => (Text, Value) -> Parser (Text, Maybe [a])
parser (x, field) = (x,) <$> (parseJSON field <|> fmap (replicate 1) <$> parseJSON field) <|> pure (x, Nothing)

UPD. `KnownSymbol` to the rescue.

Friend of mine suggested a nice idea of using KnownSymbol constraints for the Aeson instances.

instance KnownSymbol key => FromJSON (ProjectCard key) where
  parseJSON = withObject "card" $ \card -> do
    let name = symbolVal (Proxy @key)
    key <- card .: "key"
    fields <- card .: "fields"
    projectName <- fields .: "summary"
    peopleMaybe <- fields .:? fromString name <|> fmap (replicate 1) <$> fields .:? fromString name
    pure $ ProjectCard key projectName $ fromMaybe [] peopleMaybe

Turns out, you can build a Symbol by a runtime value.

fieldId <- Jira.obtainFieldId jiraConfig jiraField
SomeSymbol (Proxy :: Proxy key) <- pure $ someSymbolVal $ toString fieldId
projectCards <- Jira.projectCards (Jira.Field @key jiraField fieldId) jiraConfig

Unfortunately, JIRA API has to split because additional type parameter prevents servant’s client function to have same type in both handlers.

type JiraInternalAPI = "rest" :> "api" :> "latest" :> "field" :> Verb 'GET 200 '[JSON] [JiraField]

type JiraAPI (key :: Symbol) =
  "rest" :> "api" :> "latest" :> "search" :> RequiredParam "jql" Text :> RequiredParam "fields" Text :> RequiredParam "maxResults" Int :> Verb 'GET 200 '[JSON] (SearchResult key)

UPD 2. The more you know…

reflection package provides a handy Given constraint, which allows to (with help of FlexibleContexts and UndecidableInstances) not worry about additional type parameters in your data types:

instance Given String => FromJSON ProjectCard where
  parseJSON = withObject "card" $ \card -> do
    key <- card .: "key"
    fields <- card .: "fields"
    projectName <- fields .: "summary"
    peopleMaybe <- fields .:? fromString given <|> fmap (replicate 1) <$> fields .:? fromString given
    pure $ ProjectCard key projectName $ fromMaybe [] peopleMaybe

Upon usage, you just provide what was claimed as Given, which makes GHC happy.

projectCards :: Text -> JiraConfig -> IO [ProjectCard]
projectCards fieldName config@JiraConfig {..} = do
  fieldId <- obtainFieldId config fieldName
  runClient config $ cards <$> give (toString fieldId) searchForIssuesUsingJql (replace "{fieldName}" fieldName jql) (fieldId <> ",summary") 1000

That (and NIX flakes of course) allowed me to create several binaries for each JIRA field to test against (instead of configuring it with terminal flags or environment variables). Being tired of typing T.pack and T.unpack, I decided to give a relude a try – a custom prelude, which is quite nice to use (but I haven’t yet tried rio or universum).

configs = {
  "technical-cordinator" = p:
    p "Technical Coordinator" "Tech Coordinators";
  "cto-office-representative" = p:
    p "CTO Office Representative" "CTO Office";
  "project-manager" = p: p "Project manager" "Managers All";
  ...
};

basePackage = haskellPackages.callCabal2nix "coorish" ./. { };

package = (name: field: groups:
  basePackage.overrideDerivation (drv: {
    pname = "coorish-${name}";
    buildInputs = drv.buildInputs or [ ] ++ [ pkgs.makeWrapper ];
    postInstall = ''
      mv $out/bin/coorish-console $out/bin/coorish-${name}
      rm $out/bin/coorish-server
      wrapProgram $out/bin/coorish-${name} --set COORISH_JIRA_FIELD "${field}" --set COORISH_LDAP_GROUPS "${groups}"
    '';
  }));

Server

But having only console utilities are not useful for other people. Sometimes non-technical personnel wants to know “what is wrong” with project cards. So I decided to split the code into three parts:

Library code, which does all the heavy lifting, but free of any presentation logic
Console application to display results in terminal (nix will build multiple binaries per config value)
Web server which executes all queries to JIRA and AD in concurrently and serves result on a single page

Since web server needs all configs at once, I am concatenating everything together into flatConfig variable to pass it into coorish-server wrapper.

basePackage = haskellPackages.callCabal2nix "coorish" ./coorish { };
basePackageConsole = haskellPackages.callCabal2nix "console" ./console { coorish = basePackage; };
basePackageServer = haskellPackages.callCabal2nix "server" ./server { coorish = basePackage; };

flatConfig = (builtins.concatStringsSep ";"
  (map (f: f (a: b: "${a}=${b}")) (lib.attrValues configs)));

server = basePackageServer.overrideDerivation (drv: {
  pname = "coorish-server";
  buildInputs = drv.buildInputs or [ ] ++ [ pkgs.makeWrapper ];
  postInstall = ''
    wrapProgram $out/bin/coorish-server --set COORISH_SERVER_CONFIG "${flatConfig}"
  '';
});

Plans

I am also experimenting with generating a haskell data structure (with template-haskell) with fields, which would correspond to a JIRA project card on compile time.

createConstant :: Q [Dec]
createConstant = do
  cardTypeName <- newName "ProjectCard"
  cardConsName <- newName "ProjectCard"
  declare cardTypeName cardConsName =<< mapM process =<< runIO fields
  where
    process :: JiraField -> Q VarBangType
    process jf = do
      jName <- newName $ T.unpack $ T.replace " " "" $ T.toLower $ jiraFieldName jf
      jType <- fromJust <$> lookupTypeName (T.unpack $ T.replace "Value" "" $ T.replace "Multiple " "" $ T.replace "Single " "" $ T.pack $ show $ jiraFieldType jf)
      pure (jName, Bang NoSourceUnpackedness NoSourceStrictness, AppT ListT (ConT jType))

    declare :: Name -> Name -> [VarBangType] -> Q [Dec]
    declare cardTypeName cardConsName z = do
      pure [DataD [] cardTypeName [] Nothing [RecC cardConsName z] [DerivClause Nothing [ConT ''Show, ConT ''Generic, ConT ''FromJSON]]]

data FieldTypePlurality = IssueKey
                        | Single FieldTypeKind
                        | Multiple FieldTypeKind
                        | UnknownField deriving
                        (Generic, FromJSON, Show, Eq)

data FieldTypeKind = UserValue
                   | GroupValue
                   | StringValue
                   | DateValue
                   | DateTimeValue
                   | OptionValue
                   | NumberValue
                   | AutocompleteValue
                   deriving (Generic, FromJSON, Show, Eq)

data JiraField = JiraField
  { jiraFieldId :: Text
  , jiraFieldName :: Text
  , jiraFieldType :: FieldTypePlurality
  }
  deriving (Generic, Show)

instance FromJSON JiraField where
  parseJSON = withObject "field" $ \field -> do
    id <- field .: "id"
    name <- field .: "name"
    config <-
      if id == "issuekey"
        then pure IssueKey
        else parseSchema =<< field .:? "schema"
    pure $ JiraField id name config
   where
    parseSchema :: Maybe Object -> Parser FieldTypePlurality
    parseSchema Nothing = pure UnknownField
    parseSchema (Just schema) = parseType schema =<< schema .: "type"

    parseType :: Object -> Text -> Parser FieldTypePlurality
    parseType _ "user" = pure $ Single UserValue
    parseType _ "number" = pure $ Single NumberValue
    parseType _ "date" = pure $ Single DateValue
    parseType _ "datetime" = pure $ Single DateTimeValue
    parseType _ "option" = pure $ Single OptionValue
    parseType _ "string" = pure $ Single StringValue
    parseType schema "array" = parseArray <$> schema .: "items"
    parseType schema "any" = parseCustom <$> schema .: "custom"
    parseType _ _ = pure UnknownField

    parseArray :: Text -> FieldTypePlurality
    parseArray "user" = Multiple UserValue
    parseArray "group" = Multiple GroupValue
    parseArray "option" = Multiple OptionValue
    parseArray "string" = Multiple StringValue
    parseArray _ = UnknownField

    parseCustom :: Text -> FieldTypePlurality
    parseCustom "com.itransition.jira.plugin.customfields.jira-custom-fields:singlecomplete" = Single AutocompleteValue
    parseCustom "com.itransition.jira.plugin.customfields.jira-custom-fields:typeaheadfield" = Multiple AutocompleteValue
    parseCustom _ = UnknownField

That would allow to express programs “around” project cards in “their” language and not hardcode field names or IDs into NIX build configs. But the experiment is far from end…

People membership validation in JIRA fields against Active Directory