king: Split cert from urbit into cert+chain before giving to warp (HTTP Server library).

pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs

@@ -33,6 +33,7 @@ import Urbit.Vere.Pier.Types
 
 import Data.Binary.Builder (Builder, fromByteString)
 import Data.Bits           (shiftL, (.|.))
+import Data.PEM            (pemParseBS, pemWriteBS)
 import Network.Socket      (SockAddr(..))
 import System.Directory    (doesFileExist, removeFile)
 import System.Random       (randomIO)
@@ -502,14 +503,22 @@ httpServerPorts fak = do
 
   pure (PortsToTry { .. })
 
+parseCerts :: ByteString -> Maybe (ByteString, [ByteString])
+parseCerts bs = do
+  pems <- pemParseBS bs & either (const Nothing) Just
+  case pems of
+    [] -> Nothing
+    p:ps -> pure (pemWriteBS p, pemWriteBS <$> ps)
+
 startServ :: (HasPierConfig e, HasLogFunc e, HasNetworkConfig e)
           => Bool -> HttpServerConf -> (Ev -> STM ())
           -> RIO e Serv
 startServ isFake conf plan = do
   logDebug "startServ"
 
-  let tls = hscSecure conf <&> \(PEM key, PEM cert) ->
-              (W.tlsSettingsMemory (wainBytes cert) (wainBytes key))
+  let tls = do (PEM key, PEM certs) <- hscSecure conf
+               (cert, chain)        <- parseCerts (wainBytes certs)
+               pure $ W.tlsSettingsChainMemory cert chain $ wainBytes key
 
   sId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32)
   liv <- newTVarIO emptyLiveReqs

pkg/hs/urbit-king/package.yaml

@@ -67,6 +67,7 @@ dependencies:
   - network
   - optparse-applicative
   - para
+  - pem
   - pretty-show
   - primitive
   - process