From 75f60504ee281f19ca31c889ed5518763a7efde3 Mon Sep 17 00:00:00 2001
From: Benjamin Summers <benjamin@tlon.io>
Date: Thu, 30 Apr 2020 11:18:16 -0700
Subject: [PATCH 1/2] king: In http-server/set-config effect, key+cert is Wain,
 not Cord.

---
 pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs      |  2 +-
 pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs | 16 +++++++++++++++-
 pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs |  5 ++++-
 3 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
index 42f05c9413..49a8ce914e 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Arvo/Common.hs
@@ -78,7 +78,7 @@ instance FromNoun H.StdMethod where
 
 -- Http Server Configuration ---------------------------------------------------
 
-newtype PEM = PEM { unPEM :: Cord }
+newtype PEM = PEM { unPEM :: Wain }
   deriving newtype (Eq, Ord, Show, ToNoun, FromNoun)
 
 type Key  = PEM
diff --git a/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs b/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs
index ec58b3f2c8..77fe234d75 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Noun/Conversions.hs
@@ -8,7 +8,7 @@ module Urbit.Noun.Conversions
   , Bytes(..), Octs(..), File(..)
   , Cord(..), Knot(..), Term(..), Tape(..), Tour(..)
   , BigTape(..), BigCord(..)
-  , Wall, Each(..)
+  , Wain(..), Wall, Each(..)
   , UD(..), UV(..), UW(..), cordToUW
   , Mug(..), Path(..), EvilPath(..), Ship(..)
   , Lenient(..), pathToFilePath, filePathToPath
@@ -442,6 +442,20 @@ instance FromNoun Tape where
         Right tx -> pure (Tape tx)
 
 
+-- Wain -- List of Lines -------------------------------------------------------
+
+newtype Wain = Wain { unWain :: Text }
+  deriving newtype (Eq, Ord, Show, IsString, NFData)
+
+instance ToNoun Wain where
+  toNoun (Wain t) = toNoun (Cord <$> lines t)
+
+instance FromNoun Wain where
+  parseNoun n = named "Wain" $ do
+    tx :: [Cord] <- parseNoun n
+    pure $ Wain $ unlines (unCord <$> tx)
+
+
 -- Wall -- Text Lines ----------------------------------------------------------
 
 type Wall = [Tape]
diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs
index 66cbc8a411..ef80b3a0a2 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs
+++ b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs
@@ -216,6 +216,9 @@ writePortsFile f = writeFile f . encodeUtf8 . portsFileText
 cordBytes :: Cord -> ByteString
 cordBytes = encodeUtf8 . unCord
 
+wainBytes :: Wain -> ByteString
+wainBytes = encodeUtf8 . unWain
+
 pass :: Monad m => m ()
 pass = pure ()
 
@@ -506,7 +509,7 @@ startServ isFake conf plan = do
   logDebug "startServ"
 
   let tls = hscSecure conf <&> \(PEM key, PEM cert) ->
-              (W.tlsSettingsMemory (cordBytes cert) (cordBytes key))
+              (W.tlsSettingsMemory (wainBytes cert) (wainBytes key))
 
   sId <- io $ ServId . UV . fromIntegral <$> (randomIO :: IO Word32)
   liv <- newTVarIO emptyLiveReqs

From f66405615fe8e9852ef1d5c05909126dd9236042 Mon Sep 17 00:00:00 2001
From: Benjamin Summers <benjamin@tlon.io>
Date: Thu, 30 Apr 2020 12:13:14 -0700
Subject: [PATCH 2/2] 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 | 13 +++++++++++--
 pkg/hs/urbit-king/package.yaml                  |  1 +
 2 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs b/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs
index ef80b3a0a2..0da819e150 100644
--- a/pkg/hs/urbit-king/lib/Urbit/Vere/Http/Server.hs
+++ b/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
diff --git a/pkg/hs/urbit-king/package.yaml b/pkg/hs/urbit-king/package.yaml
index bcacee00ce..e4da0a37b9 100644
--- a/pkg/hs/urbit-king/package.yaml
+++ b/pkg/hs/urbit-king/package.yaml
@@ -67,6 +67,7 @@ dependencies:
   - network
   - optparse-applicative
   - para
+  - pem
   - pretty-show
   - primitive
   - process