Использование типов для предотвращения конфликтов номеров портов в списке

Propellor представляет собой систему, которую он развертывает как [Property], и для упрощения предположим, что data Property = Property (Set Port) SatisfyProperty

Таким образом, может существовать свойство apacheInstalled, которое использует порты 80 и 443, а также свойство torBridge, которое использует порт 443. Для системы не имеет смысла иметь оба свойства одновременно, поскольку они используют один и тот же порт 443.

Интересно, есть ли способ проверки типа, чтобы предотвратить присвоение системы и тому и другому? Тогда конфликты порта могут быть пойманы во время сборки. Я предполагаю, что этот тип уровня будет первым шагом, но я не знаю, как второй.

Ответ 1

Это довольно сложно, но вполне возможно с обновленной версией ghc (последняя платформа haskell будет работать). Это не так много примеров (так как все это довольно новое), поэтому я надеюсь, что это поможет вам.

Вы правы, что использование naturals уровня будет работать. Вам понадобятся два модуля: один для определения конструкций и обеспечения безопасного интерфейса, а другой - для определения фактических сервисов.

Этот код используется:

{-# LANGUAGE TypeOperators, PolyKinds, RankNTypes #-}
{-# LANGUAGE KindSignatures, DataKinds, TypeFamilies, UndecidableInstances #-}
module DefinedServices where
import ServiceTypes
import Control.Monad

apacheInstalled :: Service '[443] ServiceDetails
apacheInstalled = makeService "apache" $ putStrLn "Apache service"

torBridge :: Service [80,443] ServiceDetails
torBridge = makeService "tor" $ putStrLn "Tor service"

httpService :: Service [80, 8080] ServiceDetails
httpService = makeService "http" $ putStrLn "Http service"

serviceList1 :: [ServiceDetails]
serviceList1 = getServices $
               noServices `addService` httpService `addService` apacheInstalled

-- serviceList2 :: [ServiceDetails]
-- serviceList2 = getServices $
--                noServices `addService` apacheInstalled `addService` torBridge


main = startServices serviceList1

Обратите внимание, как порты для каждой службы определены в типе. serviceList1 использует службу httpService и apacheInstalled. Это компилируется, поскольку их порты не конфликтуют. serviceList2 закомментирован и вызывает эту ошибку компиляции, если она не выполнена:

DefinedServices.hs:22:56:
    Couldn't match type 'False with 'True
    Expected type: 'True
      Actual type: ServiceTypes.UniquePorts '[443, 80, 443]
    In the second argument of `($)', namely
      `noServices `addService` apacheInstalled `addService` torBridge'
    In the expression:
      getServices
      $ noServices `addService` apacheInstalled `addService` torBridge
    In an equation for `serviceList2':
        serviceList2
          = getServices
            $ noServices `addService` apacheInstalled `addService` torBridge
Failed, modules loaded: ServiceTypes.

Это довольно хорошо описывает проблему: UniquePorts заканчивается как false, поскольку 443 используется дважды.

Итак, вот как это делается в ServiceTypes.hs:

{-# LANGUAGE TypeOperators, PolyKinds, RankNTypes #-}
{-# LANGUAGE KindSignatures, DataKinds, TypeFamilies, UndecidableInstances #-}
module ServiceTypes (
  makeService, noServices, addService, Service, ServiceDetails(..) 
  , getServices, startServices) where
import GHC.TypeLits
import Control.Monad
import Data.Type.Equality
import Data.Type.Bool

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

Во-первых, для проверки уникальности списка требуется функция уровня уровня. Это использует операторы семейства типов в Data.Type.Equality и Data.Type.Bool. Обратите внимание, что следующий код выполняется только с помощью typechecker.

type family UniquePorts (list1 :: [Nat]) :: Bool
type instance UniquePorts '[] = True
type instance UniquePorts (a ': '[]) = True
type instance UniquePorts (a ': b ': rest) = Not (a == b) && UniquePorts (a ': rest) && UniquePorts (b ': rest)

Это просто рекурсивное определение единственного.

Далее, поскольку мы будем использовать сразу несколько сервисов, необходимо будет объединить два списка в один:

type family Concat (list1 :: [a]) (list2 :: [a]) :: [a]
type instance Concat '[] list2 = list2
type instance Concat (a ': rest) list2 = a ': Concat rest list2

Это все необходимые нам функции уровня уровня!

Далее я определяю тип Service, который переносит другой тип с необходимыми портами:

data Service (ports :: [Nat]) service = Service service

Далее, для конкретных деталей одной службы. Вы должны настроить это для того, что вам нужно:

data ServiceDetails = ServiceDetails {
  serviceName :: String
  , runService :: IO ()
  }

Я также добавил вспомогательную функцию для переноса службы в тип Service с определенными портами:

makeService :: String -> IO () -> Service ports ServiceDetails
makeService name action = Service $ ServiceDetails name action

Теперь, наконец, для нескольких списков служб. `noServices просто определяет пустой список сервисов, который явно не использует порты:

noServices :: Service '[] [ServiceDetails]
noServices = Service []

addService - это место, где все вместе:

addService :: (finalPorts ~ Concat ports newPorts, UniquePorts finalPorts ~ True)
  => Service ports [ServiceDetails]
  -> Service newPorts ServiceDetails
  -> Service finalPorts [ServiceDetails]
addService (Service serviceList) (Service newService) = 
  Service $ (newService : serviceList)

finalPorts ~ Concat ports newPorts просто делает finalPorts комбинацию портов в списке сервисов и новой службе. UniquePorts finalPorts ~ True гарантирует, что конечные порты не содержат дубликатов портов. Остальная функция полностью тривиальна.

getServices разворачивает [ServiceDetails] из Service ports [ServiceDetails]. Поскольку конструктор Service не становится общедоступным, единственный способ создать тип Service ports [ServiceDetails] - через функции noServices и addService, которые гарантированно будут безопасными.

getServices :: Service ports [ServiceDetails] -> [ServiceDetails]
getServices (Service details) = details

Наконец, функция тестирования для запуска служб:

startServices :: [ServiceDetails] -> IO ()
startServices services = forM_ services $ \service -> do
  putStrLn $ "Starting service " ++ (serviceName service)
  runService service
  putStrLn "------"

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