[ fix ] allow rather than require EMS in GenerateNews

msp-strath · Feb 29, 2024 · fdd3ec5 · fdd3ec5
1 parent 21adef5
commit fdd3ec5
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 0 deletions.
diff --git 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
@@ -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