_Projects.md

LDAP-bot.

That is a facebook bot (we use facebook's Workplace product as an intranet collaboration point) to manage LDAP groups.

History: Since our organization migrated to hybrid schema (AD "on land" and Azure AD "in cloud"), it is no longer possible for employees connected to the on-premises server to manage the AD groups. While our IT department is figuring out a way to provide management abilities to the employees, I decided to create a simple way to add/remove people into AD groups (our access policies depend on group membership).

It started as a typical pet project, but I wanted to try new things along the way. First implementation was very straightforward (no ReaderT pattern, explicit passing of configuration values). When I felt the urge to write some tests, it became clear that full integration tests is not an option – neither facebook doesn't like to be bombarded with messages, nor LDAP server. So I introduced a freer-simple effects system, which was later replaced with polysemy. It makes it possible to swap out some effects with mocks and write well-organized unit tests (I'm not saying they look pretty, they have to mock a lot of things after all).

At that time, the project was dockerized. I even achieved some remarkable results with statically compiling it with musl, UPC-ing the result and packing everything into scratch-based docker image (more on that in attachments). But deployment was a little bit complicated, since I had to either build docker images on a target host or use companies (which was also created and configured by me) docker registry. I started to explore options and got a second chance to look at NIX and nixops (currently I cannot imagine how I lived without it). So I NIXified the bot and even switched to the haskell.nix alternative haskell nix infrastructure.

Along with that, following my built-in craving for minimalism, I decided to try out bare cabal instead of stack, which wasn't the greatest experience (since stack is much-more user friendly and solved a lot of existing problems for you). But finally, with help of nix flakes, the project can be built the same way on darwin and linux systems.

Continuing to use the bot myself, I felt repeating pain of opening a browser and navigating to the facebook chat each time I have to add or remove someone from the group or even see who is the group manager (using ldapsearch linux utility is not so pleasant, it's output is quite cumbersome). So I decided to add a terminal interface to the bot. Same functions, but accessed from the terminal. Having nix in place, deployment configuration has changed only slightly, but I am free of browser pain now.

Screenshots:

Internals: I used servant-client to "talk" to facebook via it's graph API (do not confuse with graphQL) and servant-server to publish two endpoints facebook will hit whenever a new message arrives to the bot. All communication is JSON-based backed by aeson library. Instead of blindly mapping incoming messages to the data structures with the same shape, I decided to write a custom FromJSON instance to flatten the payload (facebook's message format is a bit crazy). LDAP communication is done with the help of ldap-client library, which is a high-level binding from corresponding C library. Lenses are used to create isomorphisms between parsed and raw configuration values (for testing environment configuration in a generic way). Polysemy is a star of the show which allows it to separate the domain language from its interpretation, inject logging in the middle of the effects stack, write mock versions of facebook, LDAP and some internal effects. Code gets built by nix and deployed via nixops as a systemd service. First implementation of tests used validity and gen-validity libraries from Tom Sydney Kerckhove (super nice Haskeller, met him on the conference), but then switched to QuickCheck and hspec, since I don't have a lot of data types to generate Validity (Arbitrary in QuichCheck terms) instances for.

Along the way of implementing and supporting that bot I wrote a number of articles about it (also Haskell and FP in general). Unfortunately, the articles are in russian and have no version: my auditory was all russian speaking employees, so there was no point in doing so. I still think it would be beneficial to include them into the story: you can still squint on it and try to see the idea or maybe you do have a friend or colleague, who can understand it ;)

Coorish utility.

A small utility to determine ineligible people being specified in our "project cards".

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. Our current version of JIRA does not allow us to validate "whether a person belongs to a certain group" for multi-people fields, only for single-user fields. 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. 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 is used for one more thing – embedding configuration values into FromJSON instances (I don't know how to parametrize them in an elegant way). 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).

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. That would allow to express programs "around" project cards in "their" language and not hardcode field IDs into NIX build configs. Why not do it on application start? That is possible, but would not allow a direct mapping between data structure fields and JIRA fields, hence – DSL would exist not on a type level, but on value level...

Screenshots:

Effects.md

Расширяемые функциональные эффекты против объектно-ориентированных интерфейсов.

С большим опозданием, продолжаю цикл статей про WP бота. Ссылки на предыдущие части: 1, 2 3 и 4. Сегодня, впрочем как обычно, речь пойдет про очедную функциональную дичь ;).

Столпом ООП является инкапсуляция (каждый раз тянет по английски это слово с i начать), которая про "сокрытие реализации". Даже самому начинающему программисту известно, что достигается инкапсуляция в mainstream языках программирования при помощи interface-ов. Я постараюсь показать совершенно иной способ инкапсуляции – экзистенциальные эффекты.

Что за абстракция такая – "эффект" и для чего нужна? Для понимания, давайте рассмотрим примитивную функцию для сложения двух чисел:

function add(a: Int, b: Int): Int {
  Logger.debug("${Time.current} - Adding numbers $a and $b.")
  return a + b;
}

Обычная функция – делает что и должна, да еще и записи в лог добавляет. Красота? С обывательской точки зрения с функцией все в порядке (возможные переполнения Int оставим за кадром). А вот с точки зрения компилятора – сплошное расстройство: вызов add(2, 2) невозможно вычислить и заменить на 4 на этапе сборки. Примерно так же на эту функцию смотрит и разработчик на Haskell – она просто "не может быть функцией". Точнее для него – это и не функция вовсе (в математическом смысле) – она не просто возвращает результат, совершая операции над аргументами. Она еще записывает сообщение в лог, должна откуда-то взять текущее время. Вызывая ее в разное время она хоть и вернет один и тот же результат, но в логи будет записаны разные строки. Обычно в таких случаях говорят, что у функции есть "побочный эффект" (side effect).

Наличие side effect-ов в императивных ЯП – обычное дело. Ими удобно пользоваться не только чтобы логи писать, но и для других, не менее Эффектных вещей – Thread.current, Time.now, println в конце концов. Проблема в том, что за удобство приходится расплачиваться. Высока ли цена? В этом примере – не очень. Подумаешь, в логи будут сыпаться сообщения при запуске unit тестов, а сама функция будет выполняться в 1000 раз медленнее чем могла бы... Если это и станет проблемой – мы либо вставим проверку if (debug) либо подменим Logger на "ничего не делающую заглушку" при запуске тестов. Один вопрос – а как мы узнаем о том, что это нужно сделать, глядя на сигнатуру функции? В том-то и дело что "никак"... Наличие side effect-а никак не отражено в сигнатуре типа, но тем не менее добавляет в код несколько неявных зависимостей – работу с логами и чтение времени.

В ООП с проблемой принято бороться только одним способом (хоть он и может выглядеть по-разному на первый взгляд) – при помощи техники Dependency Injection.

class Calculator {
  @Autowired
  val logger: Logger;

  function add(a: Int, b: Int, calendar: Calendar = Time): Int {
    logger.debug("${calendar.current} - Adding numbers $a and $b.")
    return a + b;
  }
}

В такую функцию действительно можно передать и "пустой" логгер и "константный, замороженный во времени календарь" и даже протестировать поведение side effect-а, ожидая что у логгера вызовется функция debug с аргументом-строкой, начинающейся на то, что вернет current из переданного календаря. Это ведь был всего-лишь примитивный пример, в реальных системах количество таких неявных зависимостей явно больше пальцев на прямых руках. Да и если подходить скурпулезно, то и до FizzBuzzEnterpriseEdition недалеко...

Впрочем, в функциональном Haskell тоже можно писать примерно так:

add :: Int -> Int -> IO Int
add a b = do 
  getCurrentTime >>= \time -> putStrLn(time <> " - Adding numbers" <> intercalate " and " [a, b])
  return $ a + b

Обратите внимание, возвращаемый тип теперь не Int, а IO Int. Это "позволяет" внутри функции делать что угодно – хоть с лог писать, хоть по HTTP запросы слать. Работать с такой функцией все еще можно, но только из кода, который тоже "помечен" IO. Позволяя делать что угодно, IO как вирус заражает части программы, мешая пользоваться всеми преимуществами функционального подхода. Хотелось бы явно указывать – add, в качестве side effect-ов делает не что угодно, а только логгирование и работу со временем. Суть "эффектов" в этом и заключается – определить явно какие-то операции (влияющие или зависящие от "внешнего мира") – обозвать их эффектами и использовать в сигнатуре функций. В этом случае можно будет совершенно четко видеть с какими именно эффектами функция работает (и ничего другого ей позволено не будет).

Тело функции никак не меняется, другой становится сигнатура типа:

add :: (Member TimeEffect eff, Member ConsoleEffect eff) => Int -> Int -> Effect eff Int

Читать ее можно так: допустим в композитном эффекте eff содержатся два эффекта – TimeEffect и ConsoleEffect, тогда функция add – принимая два Int-а возвращает Int, но при этом может выполнять "работу со временем" и "печатать на консоль". Посылать HTTP запросы ей не позволено, так как ни TimeEffect ни ConsoleEffect этого не позволяют. Их тоже определяет сам программист, например так:

data TimeEffect m a where
  СurrentTime :: TimeEffect m String

makeEffect ''TimeEffect

data ConsoleEffect m a where
  PrintLn :: String -> ConsoleEffect m ()
  ReadLn :: ConsoleEffect m String

makeEffect ''ConsoleEffect

Ну хорошо, вместо всепозволяющего Int -> Int -> IO Int мы теперь имеем более конкретизированное (Member TimeEffect eff, Member ConsoleEffect eff) => Int -> Int -> Effect eff Int (обратите внимание на сходство с возможной математической нотацией: add :: Int -> Int -> Effect eff Int, где eff такое, что истинны оба утверждения: Member TimeEffect eff и Member ConsoleEffect eff).

Комбинируя функции с явно определенными эффектами в одной программе (функции) – эффекты тоже объединяются:

greeting :: Member ConsoleEffect eff => Effect eff ()
greeting = do
  printLn("What is your name?")
  name <- readLn
  printLn("Hello" <> name)

measure :: (Memeber ConsoleEffect actionEff, Memeber TimeEffect measureEff) => Effect actionEff a -> Effect (measureEff : actionEff) a
measure action = do
  startTime <- currentTime
  result <- action
  endTime <- currentTime

  printLn $ "Action took: " <> endTime - startTime <> " seconds"
  return result

measure greeting :: (Memeber ConsoleEffect eff, Memeber TimeEffect eff) => Effect eff ()

По сути, мы создаем не последовательность инструкций, а сложную структуру данных – дерево последовательности вызовов и callback-ов. Дело за малым – интерпретировать (схлопнуть, вычислить) это дерево до получения единственного значения. Прелесть подхода с эффектами в том, что самостоятельно интерпретатор для дерева писать не приходится. Нужно всего-лишь "объяснить" что делать с тем или иным эффектом.

runConsole :: Member (Embed IO) r => InterpreterFor ConsoleEffect r
runConsole = interpret $ \case
  PrintLn string -> System.IO.putStrLn string
  ReadLn -> System.IO.getLine

runTime :: Member (Embed IO) r => InterpreterFor TimeEffect r
runTime = interpret $ \case
  СurrentTime -> Data.Time.Clock.getCurrentTime

Итоговый интерпретатор, которым можно выполнить всю программу (именно он будет использоваться в main), комбинируют из индивидуальных:

interpreter = runIO . runTime . runConsole

Применив получившийся интерпретатор interpreter к программе measure greeting, получим:

=> What is your name?
<= Alex
=> Hello Alex
=> Action took: 5 seconds

Для целей тестирования функции greeting можно написать специальный интерпретатор, который по readLn всегда возвращает нужную нам строку, а printLn постоянно добавляет к аккумулятору переданную ему строку. Но создавать такие интерпретаторы – на наш путь. Мы воспользуемся готовеньким и реализуем эффект ConsoleEffect в терминах двух других библиотечных эффектов – Reader и Writer. В этом случае можно будет воспользоваться уже готовыми интерпретаторами для них:

fakeInterpreter :: Effect ConsoleEffect a -> Effect (Writer String : Reader String) a
fakeInterpreter = reinterpret \case
  PrintLn string -> write string
  ReadLn -> ask

Была программа с side effect-ом ConsoleEffect, а стала программой для работы с эффектами Reader String и Writer String (про то почему reader и writer эффекты – можно и отдельную статью сделать). Выполнить ее можно получившимся "чистым" (без всяких IO и Effect) интерпретатором:

pureGreeter :: String -> [String]
pureGreeter name = intepret greeter
  where
    intepret = run . runWriter . runReader name . fakeInterpreter

Тестировать такую функцию элементарно – передаешь имя на вход, получаешь массив строк на выходе – сравниваешь с ожидаемым.

Программирование "на эффектах" – во многом схоже с программированием "на интерфейсах" из объектно-ориентированного программирования. Выделяются абстракции, которые можно в последствии подменить (в целях тестирования или другого полиморфизма). В обоих случаях ядро программы представляет собой ответ на "что делать", а на "как делать" отвечает самая внешняя часть – чем ближе к main, тем лучше. В случае ООП этим занимается DI фреймворк – регистрирует при старте программы все реализации интерфейсов, внедряет зависимости туда, где они требуются и запускает исполнение основной программы.

Вроде все "так же", зачем тогда весь этот функциональные приседания? Да, на первый взгляд отличий не так много. Но задумайтесь – ваша программа перестала быть просто программой, она стала данными, выстроенным в памяти деревом вызовов, сформулированным в терминах выбранных вами эффектов. Это ведь можно как-то использовать...

Например для интроспекции – можно пройтись по по этой структуре и чего-нибудь туда добавить – трассировку, скажем:

logConsole :: Member ConsoleEffect eff => Effect eff a -> Effect (eff : Trace) a
logConsole = intercept $ \case
  PrintLn string -> do
    trace $ unwords ["Going to print", length string, "characters"]
    printLn string
  ReadLn -> do
    trace $ unwords ["Going to read from a console"]
    result <- readLn
    trace $ unwords ["Successfully read", length result, "from a console"]
    return result

Или время заморозить, как в мультике:

fronzen :: Member TimeEffect eff => Time -> Effect eff a -> Effect (eff : Trace) a
fronzen instant = intercept $ const $ pure instant

Кстати, а вы заметили в примерах множество полей с навешанными на них Autowired аннотациями или может быть десятки аргументов в конструкторах классов? Прелесть в том, что они оказываются не нужны – роль DI framework-а играет простая композиция функций. Чуть не забыл про тесты упомянуть – благодаря тому, что все тестовые интерпретаторы не работают с IO – выполняются они довольно быстро:

Running 1 test suites...
Test suite ldap-bot-test: RUNNING...

Finished in 0.0266 seconds
66 examples, 0 failures

Env.md

ENV parsing

Тема сегодняшней статьи – чтение конфигурационных значений из переменных окружения и связанные с этим процессом трудности. В небольших системах, где нет необходимости в полноценном конфигурационном файле, принято брать настройки из переменных окружения, это один из ключевых моментов 12 factor app манифеста. Это надежный и относительно безопасный способ конфигурации, он отлично поддерживается всеми операционными системами, облачными платформами и средствами контейнеризации.

"Так а что сложного-то?" спросите вы, "в любом языке программирования есть для этого встроенные средства, сдобренные ни одним десятком библиотек, упрощающих этот процесс. Действительно, проблем с тем, чтобы прочитать значение переменной окружения нет. Но если подходить к задаче не системно, запрашивая значения переменных окружения там и тут в коде, трудности все-же начнутся. Такую программу будет сложно сопровождать, так как существует множество мест в коде системы, где идет обращение к одной и той же переменной окружения. Но самое важное – такую систему будет сложно тестировать – необходимо использовать дополнительные ухищрения для подмены значений переменных окружения в тестовом режиме работы. Трудностей, со временем, будет становиться все больше, так как с добавлением нового функционала вырастет и количество настроек.

Способ преодоления таких трудностей эволюционно-естественен – необходимо сконцентрировать работу с конфигурацией в одном месте, сделать процесс добавления новой настройки понятным, упростить доступ к настройкам в коде бизнес-логики.

Постановка задачи

В Haskell, несмотря на всю его "строгость" и приверженность к математически чистым функциям, тоже можно обращаться к переменным окружения откуда угодно, но "тут так не принято"... Язык подталкивает программиста отказаться от идеи так делать, заставляя явно отказываться от "чистоты" функций и терять все связанные с этим свойством преимущества. В мире строго-типизированных языков "удобно" не читать "настройки" посреди кода с логикой, а читать их в начале исполнения программы, преобразовать во внутреннюю структуру данных (с адекватными типами вместо строк) и использовать явно передавая такую структуру или ее части в остальные "вычисления" оставляя их свободными от side-effect-ов.

Довольно философствований, show me the code, как говорится.

data Config = Config
  { _ldapHost               :: Text
  , _ldapPort               :: PortNumber
  , _port                   :: Int
  , _verifyToken            :: Text
  , _pageToken              :: Text
  , _user                   :: Text
  , _password               :: Text
  , _activeUsersContainer   :: Dn
  , _projectGroupsContainer :: Dn
  , _projectGroupsOrgunits  :: NonEmpty Text
  }
  deriving (Eq, Show, Generic, Default)

Config – та самая структура данных с настройками, необходимыми для работы Group Manager бота. В начале работы системы, эта структура заполняется значениями из переменных окружения.

readConfig :: (Member Environment r, Member (Error Text) r) => Sem r Config
readConfig =
  Config <$> lookupText "LDABOT_LDAP_HOST"
         <*> lookupNumber "LDABOT_LDAP_PORT"
         <*> lookupNumber "LDABOT_PORT"
         <*> lookupText "LDABOT_VERIFY_TOKEN"
         <*> lookupText "LDABOT_PAGE_TOKEN"
         <*> lookupText "LDABOT_USERNAME"
         <*> lookupText "LDABOT_PASSWORD"
         <*> (Dn <$> lookupText "LDABOT_USERS_CONTAINER")
         <*> (Dn <$> lookupText "LDABOT_GROUPS_CONTAINER")
         <*> (fromList . splitOn "," <$> lookupText "LDABOT_GROUPS_ORGUNITS")

Как ни странно, функция readConfig является "чистой", хотя вроде бы и обращается к внешнему миру (то есть имеет side-effect-ы). Почему это так и как работает – я расскажу в следующей статье про "алгебраические эффекты". А пока, еще немного деталей реализации:

lookupText :: (Member Environment r, Member (Error Text) r) => Text -> Sem r Text
lookupText name = lookupEnv name >>= \case
    Nothing     -> throw $ unwords ["Please set", name, "environment variable."]
    Just string -> return $ pack string

lookupNumber :: (Read a, Member Environment r, Member (Error Text) r) => Text -> Sem r a
lookupNumber name = read . unpack <$> lookupText name

Функция lookupText обращается к операционной системе через lookupEnv name и анализирует результат. Если значения не оказалось – генерируется ошибка, в противном случае – функция возвращает значение переменной окружения. lookupNumber является надстройкой над lookupText, которая после успешного получения значения конвертирует его в число. Интересным моментом тут является оператор <$> (так же известный как fmap в Haskell или Optional.map в Java). Его использование позволяет "не засорять" код обработкой граничных случаев вида "если lookupText вернул null, то тоже вернуть null; в противном случае – преобразовать в число и вернуть". Если вы вспомнили про elvis-оператор, то знайте, он является лишь частным случаем fmap для null-ов ;)

<$> несколько раз применяется еще и внутри readConfig для тех же целей – преобразовывать прочитанное из LDABOT_USERS_CONTAINER в Dn (термин из мира LDAP, означает distinguished name) есть смысл только если там что-то было. Самое первое использование <$> немного интереснее. Помните рассказ про <$> из первой статьи про парсинг json-а? Речь шла о том, чтобы "адаптировать" конструктор структуры данных Message (который принимает строки) к "парсеру строк". Если посмотреть на такую адаптацию с другой стороны – операция <$> превращала "парсер строк" в "парсер Message-ей" постулируя "когда (и если) оригинальный парсер строк что-нибудь вернет, примени к этому конструктор Message".

С Config-ом ситуация та же, оператор <$> постулирует "когда (и если) все операнды для вызова функции Config будут готовы – вызывай". Если ранее мы конструировали Message "в контексте" парсера, который может ничего "не напарсить", то сейчас мы конструируем Config "в контексте" вычисления, которое может вернуть ошибку. fmap – он как обычный map, только не для списков, а для любых "контейнеров" или "вычислений" (деревья, Optional, парсер, генератор). Подготовка операндов происходит при помощи <*>. Его отличие от <$> в том, что теперь с обоих сторон "вычисления, которые могут вернуть ошибку". Механика сложная, зато код элегантный, без постоянных проверок (привет программистам на golang) и early return-ов.

Тестирование

С проблематикой вроде разобрались, пора начинать извлекать пользу. из "централизации" работы с настройками а так же от использования "чистых" функций (не зря же прилагались усилия). С точки зрения кода, читающего значения переменных – совершенно не важно откуда именно происходит чтение – из реальных переменных окружения или из заранее подготовленного ассоциативного массива, главное, чтобы lookupEnv возвращала Maybe Text. Определив "тестовое окружение" как простой писок ключ-значение type EnvironmentMock = [(Text, Text)], можно заставить readConfig читать данные из заранее подготовленного места.

withMockedEnvironment :: EnvironmentMock -> Sem '[Environment, Error Text] a -> Either Text a
withMockedEnvironment mockedEnv = run . runError . fakeEnvironment mockedEnv

fakeEnvironment :: Member (Error Text) r => EnvironmentMock -> InterpreterFor Environment r
fakeEnvironment mockedEnv = interpret $ \case
  LookupEnv name -> return $ unpack <$> lookup name mockedEnv

withMockedEnvironment
  [ ("LDABOT_LDAP_HOST", "host")
  , ("LDABOT_LDAP_PORT", "123")
  , ("LDABOT_PORT", "234")
  , ("LDABOT_VERIFY_TOKEN", "vtoken")
  , ("LDABOT_PAGE_TOKEN", "ptoken")
  , ("LDABOT_USERNAME", "user")
  , ("LDABOT_PASSWORD", "pass")
  , ("LDABOT_USERS_CONTAINER", "ucont")
  , ("LDABOT_GROUPS_CONTAINER", "gcont")
  , ("LDABOT_GROUPS_ORGUNITS", "ou1,ou2")
  ] readConfig `shouldBe` Right Config {
    _ldapHost = "host",
    _ldapPort = 123,
    _port = 234,
    _verifyToken = "vtoken",
    _pageToken = "ptoken",
    _user = "user",
    _password = "pass",
    _activeUsersContainer = Dn "ucont",
    _projectGroupsContainer = Dn "gcont",
    _projectGroupsOrgunits = "ou1" :| ["ou2"]
  }

Как говорит один мой знакомый, "мало вариативности". Он ярый поклонник разработки через тесты, (привет тебе, В.С.)". Ну что-ж, постараемся добавить вариативности и уважить скептиков, заявляющих при чтении таких тестов – "а как убедиться в том, что реализация не состоит из хардкода именно этих значений".

Есть такой прием в тестировании – проверять обратимость (reverse(reverse(list)) === list). Построение конфига из окружения - назовем прямым преобразованием Окружение -> Конфиг. Если бы у нас было обратное преобразование (из Конфига в Окружение, из которого такой Конфиг прочитан), то мы бы могли проверить, что применив сначала прямое преобрзование, а затем обратное – получается исходный Конфиг. Такую пару Окружения и Конфига называют изоморфной, а само преобразование – изоморфизмом. Как обычно бывает в математике – слово сложное, но за ним стоит простая идея ;)

Если сначала конфиг (абсолютно любой) преобразовать в набор пар ключ-значение, а потом из них попытаться "прочитать" конфиг обратно, то в итоге должны ведь получить исходный конфиг.

toEnvironmentMock :: Config -> EnvironmentMock
toEnvironmentMock Config {_ldapHost, _ldapPort, _port, _verifyToken, _pageToken, _user, _password, _activeUsersContainer, _projectGroupsContainer, _projectGroupsOrgunits} =
  [ ("LDABOT_LDAP_HOST", unpack _ldapHost)
  , ("LDABOT_LDAP_PORT", show _ldapPort)
  , ("LDABOT_PORT", show _port)
  , ("LDABOT_VERIFY_TOKEN", unpack _verifyToken)
  , ("LDABOT_PAGE_TOKEN", unpack _pageToken)
  , ("LDABOT_USERNAME", unpack _user)
  , ("LDABOT_PASSWORD", unpack _password)
  , ("LDABOT_USERS_CONTAINER", fromDn _activeUsersContainer)
  , ("LDABOT_GROUPS_CONTAINER", fromDn _projectGroupsContainer)
  , ("LDABOT_GROUPS_ORGUNITS", unpack $ intercalate "," $ toList _projectGroupsOrgunits)]
  where
    fromDn (Dn dn) = unpack dn

Имея прямое и обратное преобразование, можно записать:

it "reads config from complete environment" $ forAll $ \config ->
  withMockedEnvironment (toEnvironmentMock config) readConfig === Right config

Но это только success случай мы протестировали, пока не ясно как будет себя вести функция чтения конфига, если в переменных окружения будет отсутствовать одно из значений. Но погодите-ка – ведь у нас же есть способ получить окружение в виде списка ключ-значение. Достаточно только удалить из нее одну (случайную) строку и попытаться прочитать конфиг:

it "fails to read a config from incomplete environment" $ forAll $ \config -> do
  shuffled <- shuffle $ toEnvironmentMock config
  let ((missingKey, _), incompleteMock) = (head shuffled, tail shuffled)
  return $ withMockedEnvironment incompleteMock readConfig === Left (unwords ["Please set", missingKey, "environment variable."])

Ну вот, кажется удалось свести задачу тестирования функции чтения конфигурации к формированию произвольных конфигов. Эта задача для Haskell довольно типична – использовать property-based тестирование на нем очень любят. Так как структура Config состоит из достаточно примитивных типов и оберток над ними, то "произвольность" можно обеспечить с помощью всего нескольких строк.

makeArbitrary ''Config

instance Arbitrary Config where
  arbitrary = arbitraryConfig
  shrink = recursivelyShrink

Благодаря тому, что Config теперь "реализует" Arbitrary, можно создавать "генератор" конфигов – Gen Config при помощи функции arbitrary из класса.

class Arbitrary a where
  arbitrary :: Gen a

Попробуем в REPL-е сгенерировать что-нибудь случайное:

< sample (arbitrary :: Gen Config)

> Config {_ldapHost = "\nIUZ\DELu\EMUG1\DEL\1002298\11790\DC3s\STX", _ldapPort = 20, _port = -17, _verifyToken = "\SO\DLE9_1\NUL\210889\681130l\ENQ", _pageToken = "q\r;h1\959827\&1~\703396P1~\837562\190001xjf", _user = "\466790\&6\DC4j", _password = "{H", _activeUsersContainer = Dn "", _projectGroupsContainer = Dn "U\ACK\616135\570186v\672268\571313", _projectGroupsOrgunits = "\615852L$\598568\ESC6\fc" :| ["[h\DC4N[3pzk\b\SUB6\133277\14775"]}

Работает! Теперь полиморфная функция forAll, обладающая типом forAll :: (Show a, Testable prop) => Gen a -> (a -> prop) -> Property может принимать на вход "генератор конфигов" и проверять Property (по сути, чуть-чуть более хитрый предикат, где вместо == используется ===).

Env
  environment reading
    reads config from complete environment
      +++ OK, passed 100 tests.
    fails to read a config from incomplete environment
      +++ OK, passed 100 tests.

Строка +++ OK, passed 100 tests. говорит о том, что было сгенерировано 100 случайных Config-ов для проверки инварианта – конвертации "окружение" и обратно. Количество тестов всегда можно задать аргументом командной строки при запусте тестов.

$ stack test --test-arguments --qc-max-success=10000

Env
  environment reading
    reads config from complete environment
      +++ OK, passed 10000 tests.
    fails to read a config from incomplete environment
      +++ OK, passed 10000 tests.

Finished in 2.2859 seconds
2 examples, 0 failures

От каких "ошибок" защищают такие defensive (regression, golden) тесты? Например, если случайно переставить местами строки при построении конфига – тесты это отловят. Либо если попытаться захардкодить какое-нибудь одно значение на этапе построения конфига – тесты тоже просигнализируют с несовпадении значений (сгенерированное случайное значение будет отличаться от статического хардкода). Изменение названия переменных, из которых читаем конфиг, такой тест тоже "отловит", но отловит тут в кавычках, потому что такое падение теста не говорит о некорректности или неработоспособности программы, оно говорит лишь о том, что тесты нужно обновить, по сути "зашив" в процедуру генерации фейкового оружения новые названия переменных. В.С. непременно бы заметил еще на этапе написания тестов, что названия переменных повторяются и в реализации и в тестах – "не DRY", сказал бы он в code review комментарии...

Суши с лупой

Для того, чтобы избавиться из повторений, будем использовать популярную в функциональном программировании вещь – линзы. Линза, если совсем просто ее представить, это такая сущность, которая совмещает в себе getter и setter. Ну как setter... программирование же функциональное, immutability везде, нет никаких setter-ов, есть только функции Value -> Object -> Object, которые не меняют Object, а возвращают новый.

В структуре данных Config не случайно свойства начинались с символа подчеркивания, этому есть причина: для каждого поля структуры, Haskell объявит одноименную функцию с сигнатурой, например _ldapHost :: Config -> Text. Если бы поле называлось ldapHost, то часто бы возникал конфликт имен при объявлении временных "переменных". Да и смотря на использование ldapHost в коде подсознательно думаешь о нем, как о значении, а не как о функции.

Эту конвенцию "эксплуатирует" библиотека lens, позволяющая одной строкой сгенерировать линзы для каждого из полей структуры.

makeLenses ''Config

ldapHost :: Lens' Config Text
ldapPort :: Lens' Config PortNumber
...

Для чего вообще эти линзы удобны? Для работы со вложенным структурами данных в функциональном стиле. Имея список составных объектов.

data Color = Color {_shade :: Text}
data Material = Material {_kind :: Text, _color :: Color}
data Player = Player {_name :: Text, _material :: Material}

makeLenses ''Color
makeLenses ''Material
makeLenses ''Player

let players = [Player "Bender" (Material "metal" (Color "shiny"))
              ,Player "Fry" (Material "meat" (Color "yellow"))
              ,Player "Leela" (Material "meat" (Color "purple"))]

Можно выполнять нетривиальные операции "вглубь" на immutable данных используя "композицию линз" через знакомый оператор .:

< view material.color.shade $ head players
> "shiny"

< map (view $ material.color.shade) players
> ["shiny","yellow","purple"]

< map (over (material.color.shade) (append "super_")) players
> [Player {_name = "Bender", _material = Material {_kind = "metal", _color = Color {_shade = "super_shiny"}}}
  ,Player {_name = "Fry", _material = Material {_kind = "meat", _color = Color {_shade = "super_yellow"}}}
  ,Player {_name = "Leela", _material = Material {_kind = "meat", _color = Color {_shade = "super_purple"}}}]

Последний пример особенно нагляден, если бы не линзы, пришлось бы писать что-то вроде:

map (\player ->
    let material = _material player
        color = _color material
        shade = _shade color
    in player { _material = material { _color = color { _shade = append "super_" shade } } }
  ) players

Вернемся к нашей задачу из избавлению от дублирования. Объявим список пар ключ-линза – никто не запрещает так сделать, ведь линза, по сути, всего-лишь сложная функция, а функции в Haskell first-class значения:

settings = [
  ("LDABOT_LDAP_HOST",        ldapHost),
  ("LDABOT_LDAP_PORT",        ldapPort . isoRead . packed),
  ("LDABOT_PORT",             port . isoRead . packed),
  ("LDABOT_VERIFY_TOKEN",     verifyToken),
  ("LDABOT_PAGE_TOKEN",       pageToken),
  ("LDABOT_USERNAME",         user),
  ("LDABOT_PASSWORD",         password),
  ("LDABOT_USERS_CONTAINER",  activeUsersContainer . isoDn),
  ("LDABOT_GROUPS_CONTAINER", projectGroupsContainer . isoDn),
  ("LDABOT_GROUPS_ORGUNITS",  projectGroupsOrgunits . isoNonEmpty . splitted)]
  where
    isoRead :: (Read a, Show a) => Iso' a String
    isoRead     = iso show read
    isoDn       = iso (\(Dn dn) -> dn) Dn
    isoNonEmpty = iso toList fromList
    splitted    = iso (intercalate ",") (splitOn ",")

Обратите внимание на уже знакомые нам изоморфизмы снизу – пары функций, которые необходимы для преобразования линз к одному виду Lens' Config Text. Ведь исходя из типа Config линза activeUsersContainer работает с типом Dn, а мы хотим унифицировать все лизны в settings приведя их к одной, строковой сигнатуре.

Процедуру "чтения конфигурации" поменяем на свертку

readConfig :: (Member Environment r, Member (Error Text) r) => Sem r Config
readConfig = foldM reducer (Config {}) settings
  where
    reducer config (name, lens) = do
      value <- lookup name
      return $ set lens value config

Код осуществляет свертку foldM при помощи функции reducer списка settings, используя в качестве начального значения пустой Config {}. Функция reducer имеет на входе два параметра – config в качестве аккумулятор-а и пара ключ-линза из списка settings. Она читает (lookup name) значение переменной окружения, устанавливает прочитанное значение при помощи линзы в config и возвращает его. Таким образом, последовательно пройдясь по всему списку settings все поля структуры Config окажутся заполнены значениями.

Наконец-то мы можем избавиться от дублирования названий переменных в тестах. Вместо свертки, делаем простой обход списка map просматривая через линзу значения в config-е.

toEnvironmentMock :: Config -> EnvironmentMock
toEnvironmentMock config = map (\(name, lens) -> (name, view lens config)) settings

Использование инверсии, идемпотентности и других инвариантов - здорово помогает при написании тестов, Вариативность, как говорит мой знакомый - при этом "на высоте" ;)

Json.md

JSON Parsing

Что-то давно на Workplace не видно технических статей, спешу исправиться. В связи с задержкой, "градус гиковости" будет временно значительно повышен.

В публикации на прошлой неделе я рассказал про новый бот для Workplace, который помогает управлять проектными (и не только) группами не прибегая к помощи HelpDesk.

Он написан на языке программирования Haskell, что для нашей компании выбор не совсем типичный (хотя с RFX-ами на эту тему к нам обращались). Знаниями надо делиться, так что запланировал несколько статей по мотивам написания этого бота. Статьи будут раскрывать некоторые интересные аспекты реализации, которые, на первый взгляд, могут показаться странными или неочевидными, но все же позволяют по новому взглянуть на типовые задачи, возникающие при разработке ПО.

Почему Haskell?

Меня всегда привлекал этот язык программирования своей строгостью, лаконичностью и близостью к математике. Однако, написать на нем что-то более-менее крупное - шанса все не представлялось. Да, были небольшие pet-проекты, курсы по решению алгоритмических задач, но до "полноценного" production использования дело не доходило.

Но недавно я в очередной раз посетил конференцию по функциональному программированию - F(by) и твердо решил – в этот раз (пока мотивация от докладов не прошла) - надо обязательно это сделать! Задача возникла совершенно естественным способом, из рутины. В настоящее время, многих менеджеров (а в последствии и всех остальных сотрудников) перевели на использование облачных учетных записей Microsoft Office. У них пропала возможность самостоятельно редактировать состав проектных групп.

Дело в том, что синхронизация между наземным хранилищем и "облаком" может быть настроена только однонаправленная ("земля-воздух" кхе-хе). Так как Outlook у менеджеров уже облачный, то изменения, которые они пытаются с его помощью сделать, не могут попасть в наш Active Directory. Предлагаемый MIDS путь - создавать запросы в HelpDesk - меня категорически не устраивал. Вот и пришла идея этот процесс автоматизировать.

План статей пока выходит примерно такой:

• Parsing different JSON payloads into a single data structure
• Type-safe API for server endpoints and clients
• Parsing environment variables with reverse tests
• First-class Effects with pure testing
• Static linking and Dockerize application

Parsing different JSON payloads into a single data structure

Чтобы не затягивать - начнем с первой темы ;)

Обычно, при разработке API Endpoint-ов принято иметь структуры данных, которые отражают принимаемый json один-к-одному. А только потом извлекать из него значения, полезные/нужные для работы программы. Так делается для... простоты. Программист знает формат json-а, который будет на входе его сервиса и либо (в случае динамического языка программирования) парсит этот json как нетипизированный Value, либо (в случае статической типизации) парсит его в экземпляр класса, отражающий структуру приходящего json-а.

Подход, сам по себе не плох, но появляется промежуточный слой DTO, для работы приложения совершенно не обязательный. Особенно если достоверно известно (как раз мой случай), что формат этого json-а вряд-ли изменится в скором времени – json-ы мне присылает Facebook.

Пропустить промежуточную DTO можно написав собственный парсер, который сразу преобразует json в нужную для работы системы структуру данных. Звучит довольно сложно, ведь все привыкли использовать для разбора json-а готовые библиотеки, основанные на аннотациях (в случае статических языков) либо парсить json "в нетипизированный объект".

К счастью в Haskell дела с парсингом (всего, не только json) исторически обстоят намного лучше. Существуют библиотеки так называемых parsing combinator-ов, для создания эффективных парсеров при помощи композиции (композиция функций – краеугольный камень функционального программирования). С их помощью можно распарсить json прямо в нужную вам структуру данных.

Facebook (Workplace) присылает боту примерно такой json в случае поступления сообщения от пользователя:

  { "object": "page",
    "entry": [{"id": "entry_id", "time": 123,
      "messaging": [{
        "sender": {"id": "sender_id", "community": {"id": "community_id"}},
        "recipient": {"id": "recipient_id"}, "timestamp": 123,
        "message": {"mid": "mid", "text": "text"}}]}]}

И такой json в случае, если пользователь нажал на кнопку из help сообщения.

  { "object": "page",
    "entry": [{"id": "entry_id", "time": 123,
      "messaging": [{"sender": {"id": "sender_id", "community": {"id": "community_id"}},
        "recipient": {"id": "recipient_id"}, "timestamp": 123,
        "postback": {"title": "postback_title", "payload": "payload"}}]}]}

Обратите внимание на последнюю строку json сообщения, в первом случае передается message, а во втором postback. Данных много, но мне из этого всего нужен только sender_id - уникальный идентификатор отправителя (нужен для того, чтобы послать ему ответ) и text либо payload - текст сообщения, которое пользователь послал боту, либо payload (свойство payload назначается кнопке на help сообщении и присылается боту при ее нажатии пользователем).

Парсить все это я буду в такую незатейливую структуру данных:

data Messages = Messages
  { messages :: NonEmpty Message
  }

data Message = Message
  { sender_id :: String
  , text      :: String
  }

Для парсинга была выбрана стандартная для этой задачи библиотека Aeson, требующая "реализовать" интерфейс FromJSON. Не пугаемся незнакомому синтаксису, я все объясню...

instance FromJSON Messages where
  parseJSON = withObject "root object" $ \root ->
    root .: "entry" >>= fmap (Messages . fromList . toList  . join) . withArray "entries array"
      (mapM $ withObject "entry object" $ \entry ->
        entry .: "messaging" >>= withArray "messaging array"
          (mapM $ withObject "message object" $ \message ->
            Message
              <$> (message .: "sender" >>= (.: "id"))
              <*> (  (message .: "message" >>= (.: "text"))
                 <|> (message .:  "postback" >>= (.: "payload"))
                  )
          )
      )

Основой является функция withObject, первый параметр которой служебный - название объекта, который мы собираемся парсить. Первый, самый главный объект обзовём root object. Второй параметр - это λ (lambda) - то есть функция, которая на вход принимает уже распаршенный root объект и дальше вольна делать с ним все что ей хочется. А хочется ей взять (при помощи оператора .:, чтобы было похоже на разделитель : ключ-значение из json-а) из root объекта поле по ключу "entry" и начать его парсить (>>=) дальше.

Пока опустим магию fmap (Messages . fromList . toList . join), о ней позже. Что в json-е лежит по ключу "entry"? А там массив, значит необходимо воспользоваться функцией withArray первый параметр которой, по традиции - описание того, что сейчас парсим. Нужны эти описания, к слову, для того, чтобы при ошибке парсинга вывести понятную ошибку, например ошибка для json-а {"object": "page", "entry": 123} будет такая: parsing entries array failed, expected Array, but encountered Number. Так что наличие этих описаний полезно как для debug-а, так и для информативности ошибок будущего софта.

Парсим entry object, messaging array и message object уже знакомыми нам withObject и withArray, попутно не забывая итерироваться по ним при помощи mapM (аналог простого map, парсим мы все же массивы, на выходе тоже должны быть массивы). Подошли к самому интересному, созданию итоговых объектов Message.

Конструктор Message (в данном случае Message – это название "конструктора" для создания одноименной структуры Message), принимает две строки - sender_id и text. В Процессе парсинга, у нас нет "строк" (с типом String), есть только "парсеры, которые могут вернуть строку" (с типом Parser String). Так что приходится пользоваться операторами <$> и <*> для того, чтобы увязать парсеры строк и строки между собой. Фактически, оператором <$> мы "учим" конструктор Message принимать вместо строк - парсеры строк.

На месте первого параметра (там где должен быть sender_id) передаем парсер message .: "sender" >>= (.: "id") - его можно перевести на "человеческий" язык как "когда я буду парсить message, я возьму у него свойство sender, а у его содержимого возьму свойство id". То есть этот парсер, способен обработать json "sender": {"id": "sender_id", "community": {"id": "community_id"}}, вернув при этом только sender_id и проигнорировав все остальное, чего нам и нужно.

Аналогичным образом можно поступить и с text только вот не всегда "message": {"mid": "mid", "text": "text"}} от Facebook в этом месте приходит, иногда ещё и "postback": {"title": "postback_title", "payload": "payload"}} может быть. Мощь и изящество parsing combinator-ов раскрывается как раз в таких случаях. Комбинатор <|> говорит - сначала попытайся применить парсер, который слева от меня (message .: "message" >>= (.: "text"), а если он вернёт ошибку парсинга - попробуй тот, который от меня справа message .: "postback" >>= (.: "payload"). В итоге, выражение (message .: "message" >>= (.: "text")) <|> (message .: "postback" >>= (.: "payload")) распарсит либо цепочку message->text либо postpack->payload и вернет строку String. Мы скомбинировали два строковых парсера и получили на выходе тоже "парсер строк", реализующий собой операцию "выбора", на что намекал знак | в комбинаторе <|>.

Вспомним теперь про два вложенных друг в друга mapM. На уровне root object-а получается, что мы сформировали список списков сообщений, точнее вектор векторов (так как Aeson работает с векторами а не списками) то есть Vector (Vector Message). Для его "схлопывания" применим join, превратив Vector (Vector Message) в Vector Message, затем (операцию . стоит "читать" слева направо, так как он право-ассоциативен) конвертируем Vector в список при помощи toList, список в NonEmpty (это вид списков, которые не могут быть пусты, ведь должно же в нотификации от Facebook быть хотя бы одно сообщение пользователя) при помощи fromList и передадим это все в конструктор Messages.

Ух, похоже это тот самый случай, когда объяснение кода заняло раз в 10 больше символов, чем сам код... Но что в итоге? Мы можем парсить два разных сообщения в одну структуру данных, с которой работает бот. Для него ведь не важно, сам пользователь написал в чате /help или воспользовался кнопкой-подсказкой. Реагировать бот на это должен одинаково. Тесты успешно проходят:

describe "Messages spec" $ do
  let decoding :: Text -> Messages
      decoding = fromJust . decode . pack . unpack

  it "parses text message properly" $ do
    decoding [I.text|
      { "object": "page",
        "entry": [{"id": "id", "time": 1,
          "messaging": [{
            "sender": {"id": "sender_id", "community": {"id": "id"}},
            "recipient": {"id": "id"}, "timestamp": 1,
            "message": {"mid": "mid", "text": "text"}}]}]}
    |] `shouldBe` (Messages $ (Message "sender_id" "text") :| [])

  it "parses postback message properly" $ do
    decoding [I.text|
      { "object": "page",
        "entry": [{"id": "id", "time": 1,
          "messaging": [{"sender": {"id": "sender_id", "community": {"id": "id"}},
            "recipient": {"id": "id"}, "timestamp": 1,
            "postback": {"title": "title", "payload": "payload"}}]}]}
    |] `shouldBe` (Messages $ Message "sender_id" "payload" :| [])

  it "fails to parse incomplete json" $ do
    (eitherDecode "{\"object\": \"page\"}" :: Either String Messages) `shouldBe` Left "Error in $: key \"entry\" not found"

Servant.md

Servant

Итак - подошло время очередной технической статьи. На этот раз речь пойдет про API-over-HTTP. Вроде банальнейшая вещь, каждый так "сто раз делал" и чего вообще можно было на эту тему необычного придумать... Действительно, практически в любом backend-е есть слой "контроллеров", который отвечает за то, чтобы функции приложения были доступны извне по протоколу http. Кто-то использует json, кто-то xml, но общий знаменатель всегда - http.

REST API - давно стал стандартом де-факто. Все привыкли к модели ресурсов-существительных и стандартных глаголов-действий CRUDL. В code review я сам часто советую заменить action-ы up и down ресурса vote на два отдельных контроллера upvote и downvote с методом create, для соответствия принципам REST.

Но не REST-ом единым, как говорится, есть еще GraphQL, и много чего другого. Для очень маленьких приложений с одним-двумя endpoint-ами следовать заветам REST не так уж и необходимо. Сегодня мы как раз поговорим о подходе к API, который исповедует библиотека Servant из мира языка программирования Haskell, которую я использовал при написании бота Group Manager.

API как тип

Библиотека Servant требует описать все ваше API в виде типа. Одного, весьма развесистого и длинного, но все-же типа (как String или List Integer). Рассмотрим пример из практики. Endpoint, реагирующий на оповещения от Facebook-а можно описать как:

type MessageAPI = ReqBody '[JSON] Messages :> Post '[JSON] (NonEmpty SendTextMessageResponse)

Этот тип, состоит из двух частей, разделенных комбинатором :> (читать стоит как... как стрелку, например). Даже не зная всей специфики синтаксиса, можно догадаться, что речь идет о POST запросе, который в body принимает сообщение типа Messages в виде json-а и возвращает непустой список SendTextMessageResponse-ов, так же в виде json-а.

API редко состоит только из одного endpoint-а. Наш случай - не исключение, Facebook требует, чтобы у принимающей нотификации стороны был еще один метод, для верификации endpoint-а, добавим его.

type WebHookAPI =
       ReqBody '[JSON] Messages :> Post '[JSON] (NonEmpty SendTextMessageResponse)
  :<|> RequiredParam "hub.verify_token" Text :> RequiredParam "hub.challenge" Text :> Get '[PlainText] Text

При помощи комбинатора :<|> (это не emoji, это аналог операции "альтернатива" <|> из предыдущей статьи) к первому запросу добавился еще один: он реагирует на GET запрос, требует наличия двух текстовых параметров и отвечает plain текстом, без всякого json-а. Лишь только посмотрев на тип можно сразу понять протокол взаимодействия приложения с окружающим миром, не обращаясь к документации, не рыща по исходникам в поисках аннотаций над контроллерами и их методами.

Так же как и части типа объединяются между собой комбинатором :<|>, так и реализации этих endpoint-ов можно объединить в одно целое.

webhookMessage :: Messages -> Handler (NonEmpty SendTextMessageResponse)
webhookMessage = ... -- implementation omitted

webhookVerify :: Text -> Text -> Handler Text
webhookVerify = ... -- implementation omitted

entireAPI = webhookVerify :<|> webhookMessage

При этом их типы тоже объединятся. Не будем утруждать себя и спросим у REPL-а (в комплируемых языках REPL – не редкость):

> :t entireAPI
< entireAPI :: Messages -> Handler (NonEmpty SendTextMessageResponse) :<|> Text -> Text -> Handler Text

Возможности

Компилятор не даст собрать систему, в которой программист "забыл" обработать какой-то параметр или пытается ответить текстом на запрос, в контракте ответа которого требуется список. Библиотека Servant берет на себя много рутинной работы по ответу на запросы, которые "не обрабатываются", то есть не описаны (не предусмотрены) в типе. Так же Servant занимается операциями encode/decode данных в/из json или xml форматы в соответствии с заявленным в типе и обработкой ошибок, связанных с этим.

Но все же, пока ничего экстраординарного, ну описан контракт в виде типа, что с того... Наверное дело в том, что можно удобно будет описывать повторяющиеся части API? Написали один раз параметризованный тип:

--   - GET /<name>
--   - GET /<name>/id
--   - POST /<name>
type CreateReadList (name :: Symbol) a = name :>
 (                            Get  '[JSON] [a]
 :<|> Capture "id" Integer :> Get  '[JSON] a
 :<|> ReqBody '[JSON] a    :> Post '[JSON] NoContent
 )

И используем его для нескольких типов сущностей:

type API = FactoringAPI
     :<|> CreateReadList "users" User
     :<|> CreateReadList "products" Product

Если захотим в ответ на POST запрос для создания сущности начать что-то возвращать (например id созданной записи), то изменение сделанное в одном месте (вместо NoContent напишем Integer) отразится сразу и на user-ах и на product-ах, причем компилятор нам точно скажет где именно в коде начало возникать несовпадение типов, чтобы мы точно не забыли вернуть Integer из обработчика запроса.

Но эта кроличья нора несколько глубже... Так как тип известен на этапе компиляции, а в Haskell есть интроспекция типов (тоже на этапе компиляции), то можно информацию из типа использовать для... генерации кода!

Объявляемый тип API представляет собой контракт обмена сообщениями. Но сообщения же можно не только принимать, но еще и отправлять! Бот Group Manager тоже вынужден это делать для общения с пользователем. Facebook не обращает внимания на то, что вы ему шлете в ответ на нотификацию о сообщении от пользователя, ему главное чтобы HTTP код был 200. Для того, чтобы пользователю написать – нужно воспользоваться специальным Facebook Messaging API, то есть послать несколько сообщений Facebook-у по HTTP. А что если описать и этот протокол взаимодействия в виде типа?

type RequiredParam = QueryParam' '[Strict, Required]
type AccessTokenParam = RequiredParam "access_token" Text

type FBMessengerSendAPI =
       "me" :> "messages" :> ReqBody '[JSON] SendTextMessageRequest :> AccessTokenParam :> Post '[JSON] SendTextMessageResponse
  :<|> "me" :> "messages" :> ReqBody '[JSON] ServiceMessageRequest :> AccessTokenParam :> Post '[JSON] ()
  :<|> Capture "user_id" Text :> RequiredParam "fields" Text :> AccessTokenParam :> Get '[JSON] UserInfo

Первый и второй API вызовы выглядят похожими. С точки зрения Facebook это, вообще говоря, один и тот же GET endpoint на URL-е "/me/messages", который принимает json в body, но с точки зрения нас, как потребителя этой API, вызовы разные, с разным назначением и даже возвращаемым типом (в случае служебных сообщений нам "не важно" что Facebook на него ответил).

Прелесть в том, что код для методов доступа к такому API может быть автоматически сгенерирован, нужно только немного помочь компилятору, написав "заглушки" методов с сигнатурами типов:

sendTextMessage :: SendTextMessageRequest -> Token -> ClientM SendTextMessageResponse
sendServiceMessage :: ServiceMessageRequest -> Token -> ClientM SendTextMessageResponse
getUserInfo :: Text -> Text -> Token -> ClientM UserInfo

sendTextMessage :<|> sendServiceMessage :<|> getUserInfo = client (Proxy :: Proxy FBMessengerSendAPI)

Пользоваться методами можно предоставив "направление" BaseUrl Https "graph.facebook.com" 443 "/v6.0":

runClientM (getUserInfo "123" "email" (Token "access_token")) $ with graphAPIBaseUrl >>= \case
  Left error     -> -- Do something with error
  Right userInfo -> -- userInfo from Facebook, has type UserInfo

Пропадает необходимость работы с низкоуровневыми HTTP библиотеками, нет нужды вручную заниматься чтением json-а из ответа сервера, даже строить URL-ы самому не надо (обратите внимание, метод getUserInfo ничего об URL-е "не знает").

Подход, среди прочего, позволяет:

• на основании информации из типа сгенерировать код на JavaScript (или на другом языке) для доступа к такой API-шке;
• создать Swagger описание API-шки из ее типа либо наоборот, сгенерировать тип на основе Swagger описания;
• в несколько строк создать mock версию API-шки, которая бы возвращала случайные данные, но в строгом в соответствии с ожидаемым форматом;
• сгенерировать документацию в markdown формате с описанием и примерами использования;
• написать тест, который будет "долбить" все наши endpoint-ы запросами со случайными данными проверяя предикаты not500 <%> notLongerThan 1000000 (для целей нагрузочного тестирования) или onlyJsonObjects (чтобы отловить "ошибки дизайна" API вида Post '[JSON] ()).

И это не теоретические "возможности", для всего есть рабочие библиотеки. Более того, начали появляться реализации той же идеи, но вместо HTTP REST использующие gRPC (говорят сейчас так модно в мире микро-сервисных архитектур).

Refactoring

"Сломать" работающий сервис в процессе рефакторинга становится крайне проблематично. К примеру, решили мы избавиться от дублирования в описании типа FBMessengerSendAPI. В нем несколько раз повторяется часть, моделирующая префикс URL-а "/me/messages", да и описывать в каждом из endpoint-ов факт того, что "надо бы token передать" утомительно.

Прямо как в алгебраическом уравнении, "выносим за скобки" AccessTokenParam, а затем и префикс "me" :> "messages". В результате token будет применяться ко всем endpoint-ам, а префикс, только к первым двум (в соответствии со свойством дистрибутивности).

-- Initial version
type FBMessengerSendAPI =
       "me" :> "messages" :> ReqBody '[JSON] SendTextMessageRequest :> AccessTokenParam :> Post '[JSON] SendTextMessageResponse
  :<|> "me" :> "messages" :> ReqBody '[JSON] ServiceMessageRequest :> AccessTokenParam :> Post '[JSON] ()
  :<|> Capture "user_id" Text :> RequiredParam "fields" Text :> AccessTokenParam :> Get '[JSON] UserInfo

-- Step 1 - extracting AccessTokenParam
type FBMessengerSendAPI =
 AccessTokenParam :> (
       "me" :> "messages" :> ReqBody '[JSON] SendTextMessageRequest :> Post '[JSON] SendTextMessageResponse
  :<|> "me" :> "messages" :> ReqBody '[JSON] ServiceMessageRequest  :> Post '[JSON] SendTextMessageResponse
  :<|> Capture "user_id" Text :> RequiredParam "fields" Text :> Get '[JSON] GetUserInfoMessageResponse)

-- Step 2 - extracting "me" :> "messages"
type FBMessengerSendAPI =
 AccessTokenParam :> (
    "me" :> "messages" :> (
         ReqBody '[JSON] SendTextMessageRequest :> Post '[JSON] SendTextMessageResponse
    :<|> ReqBody '[JSON] ServiceMessageRequest  :> Post '[JSON] SendTextMessageResponse)
  :<|> Capture "user_id" Text :> RequiredParam "fields" Text :> Get '[JSON] GetUserInfoMessageResponse)

Соответственно, сигнатуры методов доступа к данным, тоже должны измениться. Раньше token был последним параметром, а станет первым:

sendTextMessage :: Token -> SendTextMessageRequest -> ClientM SendTextMessageResponse
sendServiceMessage :: Token -> ServiceMessageRequest -> ClientM SendTextMessageResponse
getUserInfo :: Token -> Text -> Text -> ClientM UserInfo

sendTextMessage :<|> sendServiceMessage :<|> getUserInfo = client (Proxy :: Proxy (Flat FBMessengerSendAPI))

А так как они изменились, то компилятор будет ругаться на все их использования в коде, не позволяя нам нечаянно "забыть" поменять порядок в одном из мест. Строгая и мощная система типов не всегда "стоит на пути", чаще она защищает от ошибок и предотвращает потенциальные баги ;)

Size.md

Размер имеет значение

Возможно я в этом не одинок, но меня сильно разочаровывают размеры современных приложений. Сейчас считается нормой создавать сайты, скачивающие десятки мегабайт при первой загрузке, иметь приложения для телефонов размером в несколько сотен мегабайт, базовые образы docker контейнеров занимают гигабайты... Ситуация парадоксальная – "дешевле" не заботиться о размере, так как усилия, потраченные в этом направлении будут стоить компании-разработчику дороже. Возможно это действительно так, проверить достаточно сложно. А может быть все как раз наоборот, просто не представляется возможным точно подсчитать сколько на самом деле средств тратится на трафик и "ожидания" с "простоями". А уж как большой размер скачиваемых артефактов влияет на customer и/или developer satisfaction и говорить нечего. "Современный подход" во мне пробуждает неоднозначные чувства и заставляет, в меру сил, бороться с ситуацией.

Минутка истории

Компилируемые в бинарный код языки существовали еще до начала времен. В эпоху контейнеризации преимущества "бинарников" раскрылись с новой, неожиданной стороны. Для чего вообще нужна контейнеризация? Изоляция, воспроизводимость, удобство развертывания и безопасность. Программа, представляющая собой один единственный исполняемый файл – что может быть удобнее для развертывания? Изоляцию, в какой-то мере, может предоставить операционная система. А воспроизводимость (с точки зрения сборки) и вовсе решается без использования контейнеров. Что с безопасностью? Необходимо отметить, тут есть "проблемы". Возможно вы не застали времена CGI скриптов, но в начале развития интернета, серверные приложения были обычными бинарниками, которые запускались web серверами через CGI интерфейс. И если в такой программе была ошибка/уязвимость – атакующий мог получить доступ ко всему серверу – ведь бинарник исполнялся, как правило, от пользователя под которым работал web сервер. А с учетом того, что сервера раньше виртуальными были редко – на одном и том же хосте располагались данные (почта, файлы и т.д.) многих пользователей – компрометации подвергалось все.

Сейчас CGI используется крайне редко, все чаще программы сами предоставляют http интерфейс для взаимодействия с собой, а web сервер выступает в роли proxy. Да и компилируемые в бинарный код языки для web используются все реже. Засилье виртуальных машин да интерпретаторов. Почему это не очень хорошо с точки зрения безопасности? Исполняемый файл можно назначить "точкой входа" docker контейнера, убрав из файловой системы все лишнее (кроме необходимых для работы приложения библиотек). В этом случае, даже если злоумышленник и обнаружит shell injection в программе, ничего страшного не случится – никакого командного интерпретатора внутри контейнера нет, "внедрять" вредоносный код попросту некуда.

Ruby

Если задуматься, такой трюк можно провернуть не только с системами, представляющими собой бинарный файл, но и со скриптовыми языками. Это несколько сложнее, но все-же возможно. Давайте попробуем разобраться на примере приложения, написанного на ruby.

В начале все более-менее стандартно – берем за основу официальный образ для ruby и устанавливаем зависимости из Gemfile.lock при помощи bundler-а. Библиотеки в ruby поставляются в виде исходников, складываем их в /app/vendor/bundle папку, рядом с самим приложением.

FROM ruby:2.7.0 as ruby

WORKDIR /app
COPY Gemfile* /app/
RUN bundle config --local deployment 'true'
RUN bundle config --local frozen 'true'
RUN bundle config --local no-cache 'true'
RUN bundle config --local clean 'true'
RUN bundle config --local without 'development'
RUN bundle config --local path 'vendor/bundle'
RUN bundle install
RUN mkdir .bundle && cp /usr/local/bundle/config .bundle/config
RUN rm -rf vendor/bundle/ruby/2.7.0/cache vendor/bundle/ruby/2.7.0/bin

Далее, в этом же много-stage-евом Dockerfile берем за основу distroless образ (без командного интерпретатора) и копируем из предыдущего шага библиотеки, необходимые для работы интерпретатора ruby. Как понять какие именно библиотеки нужны? Спрашивать у ldd (или otool -L в случае llvm) особого смысла нет – интерпретатор все равно кое-что загружает динамически. При помощи серии экспериментов, удается выявить, что для работы нашей программы, достаточно libz, libyaml и libgmp. Копируем библиотеки и сам интерпретатор в distroless образ.

FROM gcr.io/distroless/base-debian10 as distroless

COPY --from=ruby /lib/x86_64-linux-gnu/libz.so.* /lib/x86_64-linux-gnu/
COPY --from=ruby /usr/lib/x86_64-linux-gnu/libyaml* /usr/lib/x86_64-linux-gnu/
COPY --from=ruby /usr/lib/x86_64-linux-gnu/libgmp* /usr/lib/x86_64-linux-gnu/
COPY --from=ruby /usr/local/lib /usr/local/lib
COPY --from=ruby /usr/local/bin/ruby /usr/local/bin/ruby
COPY --from=ruby /usr/local/bin/bundle /usr/local/bin/bundle

Цель достигнута, образ не содержит командного интерпретатора и другой шелухи (man страниц, файлов настроек операционной системы и т.д.). Но мы на этом на остановимся и следующим шагом соберем образ буквально FROM scratch. scratch – это образ "без ничего", он пуст. Так что мы смеем надеяться, что ничего лишнего (не жизненно необходимого для работы приложения) в итоговом образе не будет. Кроме самого приложения (набора *.rb файлов) понадобиться еще файл с корневыми сертификатами, без которого не обойтись при общении с внешними сервисами по https.

FROM scratch

COPY --from=ruby /app /app

COPY --from=distroless /lib /lib
COPY --from=distroless /lib64 /lib64
COPY --from=distroless /usr/local /usr/local
COPY --from=distroless /usr/lib/ssl /usr/lib/ssl
COPY --from=distroless /usr/lib/x86_64-linux-gnu/lib* /usr/lib/x86_64-linux-gnu/
COPY --from=distroless /etc/ssl /etc/ssl
COPY --from=distroless /home /home

WORKDIR /app
COPY dialogs /app/dialogs/
COPY services /app/services/
COPY *.rb /app/

ENV SSL_CERT_FILE /etc/ssl/certs/ca-certificates.crt
ENV RUBYOPT -W:no-deprecated -W:no-experimental

CMD ["bundle", "exec", "ruby", "server.rb"]

Итоговый размер образа – 61 мегабайт. Уверен, можно было бы еще десяток сбросить при помощи утилиты dive (крайне рекомендую к использованию), удалив неиспользуемые части стандартной библиотеки языка и зависимостей ruby программы. Но вот эту часть, уже можно считать экономически нецелесообразной...

Если бы мы ставили перед собой цель максимально уменьшить размер приложения, то, скорее всего, воспользовались бы alpine linux образом, который славится малым начальным размером а так же схлопнули бы все слои docker образа в один (чтобы избавиться от удаленных файлов в нижних слоях). В этом случае, размер получившего образа мог быть даже меньше, однако преимуществ безопасности мы бы не достигли.

Кроме преимуществ, у такого подхода есть и недостатки. К примеру, больше нельзя подключиться к работающему контейнеру и "посмотреть" логи, их просто нечем выводить, да и некуда – ни bash ни cat в образе нет. Вот он, микро-сервис во всей красе – пишет логи в stdout.

Kotlin

Буквально на днях познакомился с GraalVM и он меня покорил. Одной из функций GraalVM является сборка native бинарников из jar файлов. Да, именно так: вы можете взять свое приложение, собрать его в обычный fat jar (с зависимостями), а затем "скомпилировать" в исполняемый бинарь.

У меня есть маленькая поделка для "причесывания" названий ресурсных и проектных карт. Дело в том. что в процессе создания, иногда в начале или в конце title-а оставляют пробелы, что мешает потом эффективно работать с такими картами. Очень давно я написал программу, чтобы автоматизировать процесс trim-а. Целью было, конечно, не это, а исследование возможностей библиотеки ("com.github.rcarz", "jira-client", "master") для доступа к JIRA через приятный DSL.

const val RESOURCE_CARDS = "RESCARD"
const val PROJECT_CARDS = "PROJCARD"

const val PAGINATION_SIZE = 999

val dotenv = DotEnv.load()
val jira = JiraClient(dotenv["JIRA_URL"], BasicCredentials(dotenv["JIRA_USERNAME"], dotenv["JIRA_PASSWORD"]))

fun makeQuery(block: JqlQueryBuilder.() -> Unit) : String =
        JqlStringSupportImpl(DefaultJqlQueryParser()).generateJqlString(newBuilder().also { block(it) }.buildQuery())

fun trim(project : String) {
    println("Searching for issues in ${project}.")
    jira.searchIssues(makeQuery {
        where().project(project)
        orderBy().createdDate(ASC)
    }, SUMMARY, PAGINATION_SIZE).iterator().asSequence().toList().filter {
        it.summary.trim() != it.summary
    }.also {
        if (it.count() == 0) {
            println("No issues in ${project}, that needs to be trimmed was found.")
        } else {
            println("Found ${it.count()} issues in ${project}, that needs to be trimmed.")
        }
    }.forEach {
        println("Trimming ${it.key} with summary '${it.summary}'.")
        it.update().field(SUMMARY, it.summary.trim()).execute()
    }
}

fun main(args: Array<String>) {
    MockComponentWorker().init()
    listOf(RESOURCE_CARDS, PROJECT_CARDS).forEach(::trim)
}

Для построения JQL запроса (не строкой, а при помощи DSL) к JIRA я использовал библиотеки самого Atlassian-а (библиотека для тестов необходима для инициализации core, в тестовом режиме, в противном случае core остается очень недоволен тем, что запущен вне контекста JIRA):

  implementation("com.atlassian.jira", "jira-core", "8.8.1")
  implementation("com.atlassian.jira", "jira-tests", "8.8.1")

Собрав fat jar с этими и еще некоторыми прямыми (сам kotlin, библиотека для работы с переменными окружения, etc.) и косвенными зависимостями (только представьте сколько зависимостей за собой "тянет" jira-core) получаем trimmer-1.0-all.jar размером в 112 мегабайт – такова цена за code-reuse. Настало время для GraalVM – попробуем преобразовать jar файл в обычный исполняемый файл, в надежде избавиться от главной зависимости – виртуальной java машины.

native-image -cp ./build/libs/trimmer-1.0-all.jar -H:Name=trimer-exe -H:Class=TrimmerKt -H:+ReportUnsupportedElementsAtRuntime --allow-incomplete-classpath

Попытка "в лоб" заканчивается неудачей, логи полны сообщений вида:

Error: Classes that should be initialized at run time got initialized during image building:
org.apache.log4j.spi.LoggingEvent was unintentionally initialized at build time.
org.apache.http.HttpEntity was unintentionally initialized at build time.
...
Error: Image build request failed with exit status 1

Не отчаиваемся и просим GraalVM пытаться инициализировать это все на этапе сборки образа:

native-image --no-server --enable-https --allow-incomplete-classpath -cp ./build/libs/trimmer-1.0-all.jar -H:Name=trimer-exe -H:Class=TrimmerKt --initialize-at-build-time=org.apache.http,org.slf4j,org.apache.log4j,org.apache.commons.codec,org.apache.commons.logging

Успех, на выходе имеем trimer-exe файл, размером всего в 6.5 мегабайт. Упакуем его дополнительно замечательной утилитой upx, которая знакома всем еще со времен DOS и недостатка места на диске. Результат изумителен – 1.8 мегабайт! Да только вот нас немного обманули... GraalVM, по умолчанию, строит образы, которые хоть и являются исполняемыми, но они не в состоянии работать без установленной на компьютере java виртуальной машины. При попытке построить "настоящий" независимый образ (опция --no-fallback), сталкиваемся с рядом сложностей.

Во-первых – Warning: Aborting stand-alone image build. Detected a FileDescriptor in the image heap появляющийся из-за статической инициализации поля org.apache.log4j.LogManager.repositorySelector. Дело в том, что в глубинах зависимостей нашего приложения есть части, инициализирующиеся на этапе загрузки классов – а именно – это код в блоках static и статические члены классов в java. В основном – это logging framework-и (их по дереву зависимостей наберется несколько штук), которые требуют указания class-а для создания logger объекта. Они обладают возможностью ленивой инициализации при первом использовании, при помощи reflection загружая подходящую реализацию, от чего GraalVM становится дурно (действительно, сохранить открытый FileDescriptor в дампе памяти – невыполнимая задача), он отчаянно требует помощи. Попробуем заглушить инициализацию log4j, мы ведь им и не пользуемся даже: добавляем в начале main строку LogManager.setRepositorySelector(DefaultRepositorySelector(NOPLoggerRepository()), null), а в момент сборки образа добавляем опцию -Dlog4j.defaultInitOverride=true. Как до этого "дойти"? Исключительно чтением исходных текстов библиотеки. Сложно недооценить количество знаний и понимания внутреннего устройства систем, получаемых таким образом – не бойтесь заглядывать под капот используемым библиотекам!

К слову, еще до использования GraalVM я замечал, что при запуске приложения создается папка target (хоть я и использую gradle, который все кладет в папку build) с пустым файлом unit-tests.log в ней. Подозрения пали на com.atlassian.jira:jira-tests зависимость, в недрах которой обнаружился log4j.properties файл с незатейливым содержимым:

log4j.appender.console=org.apache.log4j.FileAppender
log4j.appender.console.File=target/unit-tests.log

Разработчики из Atlassian подумали, что это отличная идея – перенаправить все что должно выводиться на консоль – в файл. Хорошая это идея или кошмарная – каждый решает за себя, но вот делать это "втихую", просто из-за наличия зависимости – верх эгоизма.

За одно отключим еще один logging framework – slf4j. Для этого добавим в начало main грязный хакстроку:

LoggerFactory::class.java.getDeclaredField("INITIALIZATION_STATE").also { it.isAccessible = true }.set(LoggerFactory::class, LoggerFactory::class.java.getDeclaredField("NOP_FALLBACK_INITIALIZATION").also { it.isAccessible = true }.get(LoggerFactory::class))

Она заставит slf4j пропустить инициализацию и не заниматься reflection-ом во время старта приложения. А статическую инициализацию одного из наших полей, сделаем отложенной (чтобы "трюк" из main успел выполниться вовремя):

val jira = lazy { JiraClient(dotenv["JIRA_URL"], BasicCredentials(dotenv["JIRA_USERNAME"], dotenv["JIRA_PASSWORD"])) }

Кстати, именно из-за статической инициализации приложения на java так медленно стартуют, а при старте иногда можно видеть в консоли строки:

log4j:WARN No appenders could be found for logger (org.apache.http.impl.conn.PoolingClientConnectionManager).
log4j:WARN Please initialize the log4j system properly.
log4j:WARN See http://logging.apache.org/log4j/1.2/faq.html#noconfig for more info.

GraalVM как раз и славится тем, что позволяет сократить время запуска приложений, так как вся статическая инициализация происходит на этапе "сборки", в готовый исполняемый файл, вместе со встраиваемой виртуальной машиной, попадают "замороженные" версии классов, с уже выполненным шагом статической инициализации.

native-image --no-fallback --allow-incomplete-classpath --enable-https --no-server -cp ./build/libs/trimmer-1.0-all.jar -H:Name=trimer-exe -H:Class=TrimmerKt --initialize-at-build-time=org.apache.http,org.apache.log4j,org.slf4j,org.apache.commons.logging,org.apache.commons.collections.map,net.sf.json,net.sf.ezmorph,org.apache.oro.text.regex,org.apache.commons.codec -Dlog4j.defaultInitOverride=true

Следующая беда "вылазит" уже не на этапе сборки, а после запуска собранного приложения:

Exception in thread "main" java.lang.NoClassDefFoundError: java.lang.Class
  at net.sf.json.AbstractJSON.class$(AbstractJSON.java:53)
  ...
  at net.rcarz.jiraclient.RestClient.request(RestClient.java:165)
  ...

Общение с JIRA происходит при помощи JSON-а, а его разбор в java большинством библиотек происходит через reflection, возможности которого в GraalVM несколько ограничены. GraalVM понимает, что необходимо "встроить" нужные вызовы к reflection API в итоговый образ, если они происходят на этапе статической инициализации, но вот к вызовам reflection во время исполнения его "никто не готовил". Создадим файл config.json с таким содержимым:

[
  {
    "name" : "java.lang.String"
  },
  {
    "name" : "java.lang.Class"
  }
]

Заставим GraalVM обратить на него внимание:

native-image --no-fallback --allow-incomplete-classpath --enable-https --no-server -cp ./build/libs/trimmer-1.0-all.jar -H:Name=trimer-exe -H:Class=TrimmerKt --initialize-at-build-time=org.apache.http,org.apache.log4j,org.slf4j,org.apache.commons.logging,org.apache.commons.collections.map,net.sf.json,net.sf.ezmorph,org.apache.oro.text.regex,org.apache.commons.codec -Dlog4j.defaultInitOverride=true -H:ReflectionConfigurationFiles=./config.json

В итоге, собранная программа работает как положено. Итоговый размер – 28 мегабайт, а будучи упакованным при помощи upx – 7.1 мегабайт. Не удивительно, ведь GraalVM пришлось включить в исполняемый файл Substrate VM виртуальную машину для того, чтобы бинарный файл стал независим от системного JRE. Обещания, которые давал GraalVM он выполнил – один исполняемый файл, независимость от системного JRE. К слову, время старта приложения значительно сократилось – разница заметна даже невооруженным взглядом:

➜ time java -jar build/libs/trimmer-1.0-all.jar --dry-run
0.30s user 0.05s system 181% cpu 0.195 total
➜ time ./trimer-exe --dry-run
0.00s user 0.00s system 70% cpu 0.010 total

Haskell

Напоследок, попробуем получить преимущества от статической линковки программы на Haskell, бота Group Manager. Сборка программ на Haskell внутри docker-а происходит примерно так же как и на golang. В первом stage-е устанавливаются все необходимые зависимости, собирается бинарный исполняемый файл. Затем он из этого stage-а копируется в "чистовой" контейнер, не содержащий компилятора и других development зависимостей.

Самая первая версия бота так и собиралась, итоговый бинарный файл имел размер 26 мегабайт, а docker образ (на основе того же distroless) – 46 мегабайт.

FROM haskell:8.6.5 as haskell

RUN mkdir /app
WORKDIR /app

ADD stack.yaml .
ADD stack.yaml.lock .
ADD package.yaml .

RUN mkdir src
RUN mkdir app
RUN mkdir test

RUN stack setup
RUN stack build || true

ADD . .

RUN stack install

FROM gcr.io/distroless/base
COPY --from=haskell /lib/x86_64-linux-gnu/libz* /lib/x86_64-linux-gnu/
COPY --from=haskell /usr/lib/x86_64-linux-gnu/libgmp* /usr/lib/x86_64-linux-gnu/

COPY --from=haskell /root/.local/bin/ldabot-exe /app

ENTRYPOINT ["/app"]

В принципе, не так и плохо, но можно лучше! Если добавить опции для статической сборки и использовать scratch в качестве базового образа (никакие библиотеки ведь теперь не нужны), получается исполняемый файл размером 28 мегабайт и такого же размера docker образ (состоит он, по сути, из одного единственного файла).

FROM haskell:8.6.5 as haskell

RUN mkdir /app
WORKDIR /app

ADD stack.yaml .
ADD stack.yaml.lock .
ADD package.yaml .

RUN mkdir src
RUN mkdir app
RUN mkdir test

RUN stack setup
RUN stack build || true

ADD . .

RUN sed -i "s/    ghc-options:/    cc-options: -static\n    ld-options: -static -pthread\n    ghc-options:\n    - -O2\n    - -static/g" package.yaml

RUN stack install --executable-stripping
RUN strip /root/.local/bin/ldabot-exe

FROM scratch

COPY --from=haskell /root/.local/bin/ldabot-exe /app

ENTRYPOINT ["/app"]

Стоит ли останавливаться на достигнутом? Конечно же нет! Существует такая штука как musl – альтернативная реализация libc библиотеки, которая славится малым размером (кроме других своих достоинств). Именно благодаря ей alpine linux имеет такой скромный размер. Мир полон добрых людей, существуют сборка компилятора GHC 8.6.5 "под" musl – utdemir/ghc-musl:v4-libgmp-ghc865, ей мы и воспользуемся.

FROM utdemir/ghc-musl:v4-libgmp-ghc865 as haskell

RUN mkdir /app
WORKDIR /app

RUN cabal update
ADD ldabot.cabal .
RUN cabal build || true

ADD . .
RUN cabal new-install
RUN strip --strip-all /root/.cabal/bin/ldabot-prod

FROM alpine as upx

RUN apk add -u upx

COPY --from=haskell /root/.cabal/bin/ldabot-prod /app
RUN upx --best /app

FROM scratch

COPY --from=gcr.io/distroless/base /etc/ssl /etc/ssl
COPY --from=upx /app /app

ENTRYPOINT ["/app"]

Благодаря musl (и, конечно, upx) удалось добиться бинарника размером 5.9 мегабайт. docker образ, при этом, стал чуть больше – 6.1 мегабайт, так как дополнительно пришлось копировать SSL сертификаты для работы (исходный код к этому времени стал обращаться к внешним сервисам по https).

Текущая версия бота собирается чуть иначе. Причина этому – использование более новой версии компилятора GHC 8.8.3. Того требует одна из зависимостей polysemy – is a library for writing high-power, low-boilerplate, zero-cost, domain specific languages, о которой я постараюсь вскоре рассказать. Для GHC 8.8.3, на момент создания бота, поддержки musl еще "на завезли". Сборка работает при помощи stack (это как gradle для java), который "из коробки" умеет исполнять команды сборки внутри контейнера. Необходимо только указать базовый образ и запустить сборку при помощи команды stack build --docker

docker:
  image: "fpco/stack-build-small:latest"

Dockerfile при этом выглядит необычно – внутри не происходит никакой сборки, только сжатие upx-ом и копирование библиотек.

FROM alpine as upx

COPY .stack-work/docker/_home/.local/bin/ldabot-prod /app
RUN apk add -u upx
RUN upx --best --ultra-brute /app

FROM scratch

COPY --from=gcr.io/distroless/base /etc/ssl /etc/ssl
COPY --from=upx /app /app
COPY --from=fpco/stack-build:lts-14.25 /lib/x86_64-linux-gnu/ld-linux* /lib/x86_64-linux-gnu/libc.* /lib/x86_64-linux-gnu/libnss_dns.* /lib/x86_64-linux-gnu/libresolv.* /lib/

ENTRYPOINT ["/app"]

Постойте, какие библиотеки, речь же шла о статической линковке... Дело в том, что libc, в отличие от musl не может быть полностью "влинкован" в приложение. Причин несколько, но для обывателя их можно сформулировать как "так получилось". Обратите внимание на то, какие именно библиотеки мы копируем – libnss_dns и libresolv (ну и еще ld-linux для возможности динамической загрузки последних). Это библиотеки для работы с DNS, а инфраструктура NSS предоставляет много backend-ов для работы с DNS (вплоть до чтения из файла). Так как нет возможности на этапе сборки указать какой именно backend использовать, libc всегда загружает их динамически, заставляя "тянуть" еще и себя, кроме необходимых NSS плагинов. С таким положением дел все до сих пор мирятся (убеждая окружающих, что статическая линковка "не нужна", ведь все равно придется "тянуть" с собой libc), периодически "сбегая" в лагерь musl, если нужна "действительно" статическая линковка.

В итоге, вышел компромиссный вариант (из-за невозможности использовать musl) – статическая линковка (размер исполняемого файла 4.6 мегатайта), вместе с libc и библиотеками для DNS, сделали размер образа не таким большим – всего 7.2 мегабайта. Цель по уменьшению размера итогово образа и обеспечению дополнительной безопасности можно считать достигнутой. Особенно греет душу мысль о том, что бот в состоянии покоя занимает в оперативной памяти всего 812 килобайт!

Cmp   Size  Command
4.6 MB  ├── app
246 kB  ├── etc
246 kB  │   └── ssl
235 kB  │       ├── certs
235 kB  │       │   └── ca-certificates.crt
 11 kB  │       └── openssl.cnf
2.3 MB  └── lib
171 kB      ├── ld-linux-x86-64.so.2
2.0 MB      ├── libc.so.6
 27 kB      ├── libnss_dns.so.2
101 kB      └── libresolv.so.2

Total Image size: 7.2 MB
Potential wasted space: 0 B
Image efficiency score: 100 %