From f71ff68b5be1522abb50a8d28c3764c41c0c9205 Mon Sep 17 00:00:00 2001
From: KtorZ <matthias.benkort@gmail.com>
Date: Fri, 21 Jul 2023 00:06:13 +0200
Subject: [PATCH] Allow connecting to remote Ogmios hosts behind TLS

  Fixes #128.
---
 CHANGELOG.md                     | 14 ++++++++++++++
 kupo.cabal                       |  1 +
 package.yaml                     |  1 +
 src/Kupo/App/ChainSync/Ogmios.hs | 16 ++++++++++++++--
 src/Kupo/Options.hs              |  2 +-
 5 files changed, 31 insertions(+), 3 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 2efa01a3..a0dccf8f 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,17 @@
+### [2.4.2] - unreleased
+
+#### Added
+
+- Allow connection to remote Ogmios hosts behind TLS. This is now possible by prefixing the hostname with `wss://`.
+
+#### Changed
+
+N/A
+
+#### Removed
+
+N/A
+
 ### [2.4.1] - 2023-06-29
 
 #### Added
diff --git a/kupo.cabal b/kupo.cabal
index 0bc6dac0..44e0569f 100644
--- a/kupo.cabal
+++ b/kupo.cabal
@@ -218,6 +218,7 @@ library
     , warp
     , websockets
     , websockets-json
+    , wuss
     , yaml
   default-language: Haskell2010
   if flag(production)
diff --git a/package.yaml b/package.yaml
index 39b4273e..4abf2cf3 100644
--- a/package.yaml
+++ b/package.yaml
@@ -100,6 +100,7 @@ library:
     - warp
     - websockets
     - websockets-json
+    - wuss
 
 tests:
   unit:
diff --git a/src/Kupo/App/ChainSync/Ogmios.hs b/src/Kupo/App/ChainSync/Ogmios.hs
index 19b89727..b6a1887d 100644
--- a/src/Kupo/App/ChainSync/Ogmios.hs
+++ b/src/Kupo/App/ChainSync/Ogmios.hs
@@ -15,6 +15,9 @@ import Kupo.Prelude
 import Control.Exception.Safe
     ( MonadThrow
     )
+import Data.List
+    ( stripPrefix
+    )
 import Kupo.App.Mailbox
     ( Mailbox
     , putHighFrequencyMessage
@@ -44,6 +47,7 @@ import Kupo.Data.Ogmios
 
 import qualified Network.WebSockets as WS
 import qualified Network.WebSockets.Json as WS
+import qualified Wuss as WSS
 
 runChainSyncClient
     :: forall m.
@@ -91,11 +95,19 @@ connect
     -> Int
     -> (WS.Connection -> IO a)
     -> IO a
-connect ConnectionStatusToggle{toggleConnected} host port action =
-    WS.runClientWith host port "/"
+connect ConnectionStatusToggle{toggleConnected} url port action =
+    runClientWith port "/"
         -- TODO: Try to negotiate compact mode v2 once available.
         --
         -- See [ogmios#237](https://github.com/CardanoSolutions/ogmios/issues/237)
         --
         -- [("Sec-WebSocket-Protocol", "ogmios.v1:compact")]
         WS.defaultConnectionOptions [] (\ws -> toggleConnected >> action ws)
+  where
+    runClientWith =
+        case stripPrefix "wss://" url of
+            Just host ->
+                WSS.runSecureClientWith host . fromIntegral
+            _ ->
+                let host = fromMaybe url (stripPrefix "ws://" url)
+                 in WS.runClientWith host
diff --git a/src/Kupo/Options.hs b/src/Kupo/Options.hs
index 0c9ac467..fbfe244f 100644
--- a/src/Kupo/Options.hs
+++ b/src/Kupo/Options.hs
@@ -202,7 +202,7 @@ serverHostOption :: Parser String
 serverHostOption = option str $ mempty
     <> long "host"
     <> metavar "IPv4"
-    <> help "Address to bind to."
+    <> help "Address to bind to. Prefix with 'wss://' to connect to hosts behind TLS."
     <> value "127.0.0.1"
     <> showDefault
     <> completer (bashCompleter "hostname")