Question

Propellor代表它部署为[Property]的系统，为简化起见，我们假设data Property = Property (Set Port) SatisfyProperty

因此，可能存在使用端口80和443的apacheInstalled属性，以及使用端口443的torBridge属性。系统具有这两个属性没有意义同时，因为他们使用相同的端口443。

我想知道类型检查器是否有可行的方法来防止同时分配系统？然后可以在构建时捕获端口冲突。我认为类型级别Ints将是第一步，但我对第二步没有任何线索..

Answer 1

这非常棘手，但完全可以使用最新的ghc版本（最新的haskell平台可以使用）。关于这个的例子并不多（因为它都很新），所以我希望这对你有帮助。

你是对的，使用类型级自然会起作用。您将需要两个模块 - 一个用于定义构造并提供安全接口，另一个用于定义实际服务。

这是正在使用的代码：

{-# 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最终是假的，因为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函数，这些函数可以保证安全。< / p>

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版本有了很大的改进（它仍然可能，但很多更难）。一旦你开始使用类型中的值，这段代码就非常简单了。

使用类型来防止列表中的端口号冲突

1 个答案: