From fdd3ec5ad21c08263df02531b8eb63249016f0b2 Mon Sep 17 00:00:00 2001
From: Fredrik Nordvall Forsberg <fredrik.nordvall-forsberg@strath.ac.uk>
Date: Thu, 29 Feb 2024 10:29:47 +0000
Subject: [PATCH] [ fix ] allow rather than require EMS in GenerateNews

---
 GenerateNews.hs | 20 ++++++++++++++++++++
 MSPweb.cabal    |  4 ++++
 2 files changed, 24 insertions(+)

diff --git a/GenerateNews.hs b/GenerateNews.hs
index 00a2681..55a9919 100644
--- a/GenerateNews.hs
+++ b/GenerateNews.hs
@@ -9,9 +9,12 @@ import Data.List
 import Data.Maybe
 import Data.Function
 
+import Data.Default (def)
+
 -- import Data.ByteString.Lazy (ByteString)
 -- import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as BS8
 import Data.Text (Text)
 import qualified Data.Text as T
 
@@ -22,6 +25,10 @@ import Data.Foldable
 import Network.HTTP.Client
 import Network.HTTP.Client.TLS
 import Network.HTTP.Types.Status
+import Network.TLS (defaultParamsClient, clientShared, clientSupported, sharedCAStore, supportedCiphers, supportedExtendedMainSecret, EMSMode(..))
+import Network.TLS.Extra (ciphersuite_default)
+import Network.Connection (TLSSettings(..))
+import System.X509 (getSystemCertificateStore)
 
 import Data.Time
 import Data.Time.Format
@@ -117,6 +124,19 @@ pubsRSS = parseRequest_ "https://pureportal.strath.ac.uk/en/organisations/mathem
 getPureRSS :: Int -- number of entries
            -> IO [Item]
 getPureRSS n = do
+  certificateStore <- getSystemCertificateStore
+  let tlsSettings = TLSSettings $
+        (defaultParamsClient
+                          (show $ host pubsRSS)
+                          (BS8.pack $ show $ port pubsRSS))
+          { clientSupported = def { supportedCiphers =
+                                      ciphersuite_default
+                                  , supportedExtendedMainSecret =
+                                      AllowEMS
+                                  }
+          , clientShared = def { sharedCAStore = certificateStore }
+          }
+  let tlsManagerSettings = mkManagerSettings tlsSettings Nothing
   manager <- newManager tlsManagerSettings
   res <- httpLbs pubsRSS manager
   case statusIsSuccessful (responseStatus res) of
diff --git a/MSPweb.cabal b/MSPweb.cabal
index 32eb6a7..373f7ff 100644
--- a/MSPweb.cabal
+++ b/MSPweb.cabal
@@ -47,12 +47,16 @@ executable GenerateNews
   main-is:          GenerateNews.hs
   other-modules:    Html
   build-depends:    base,
+                    crypton-connection,
+                    crypton-x509-system,
+                    data-default,
                     yaml,
                     bytestring,
                     http-client,
                     http-client-tls,
                     http-types,
                     time,
+                    tls,
                     feed,
                     text
   default-language: Haskell2010