Implement TLS for API server

app/Main.hs

@@ -6,7 +6,9 @@ import Control.Concurrent (forkIO)
 import Data.Configurator
 import Data.SecureMem
 import Database.MongoDB
-import Network.Wai.Handler.WarpTLS (tlsSettings)
+import Network.Wai.Handler.Warp (defaultSettings, setPort)
+import Network.Wai.Handler.WarpTLS (runTLS, tlsSettings)
+import Web.Scotty
 import ZGoBackend
 
 main :: IO ()
@@ -36,4 +38,9 @@ main = do
   _ <- forkIO (setInterval 75 (scanZcash nodeAddress pipe dbName))
   _ <- forkIO (setInterval 60 (checkPayments pipe dbName))
   _ <- forkIO (setInterval 60 (expireOwners pipe dbName))
-  app pipe dbName passkey nodeAddress port myTlsSettings
+  let appRoutes = routes pipe dbName passkey nodeAddress
+  case myTlsSettings of
+    Nothing -> scotty port appRoutes
+    Just tls -> do
+      apiCore <- scottyApp appRoutes
+      runTLS tls (setPort port defaultSettings) apiCore

package.yaml

@@ -72,6 +72,7 @@ executables:
     - bytestring
     - configurator
     - warp-tls
+    - warp
 
 tests:
   zgo-backend-test:

src/ZGoBackend.hs

@@ -29,7 +29,6 @@ import GHC.Generics
 import Item
 import Network.HTTP.Simple
 import Network.HTTP.Types.Status
-import Network.Wai.Handler.WarpTLS (TLSSettings, runTLS)
 import Network.Wai.Middleware.Cors
 import Network.Wai.Middleware.HttpAuth
 import Numeric
@@ -314,18 +313,10 @@ upsertZGoTx :: T.Text -> ZGoTx -> Action IO ()
 upsertZGoTx coll t = do
   upsert (select ["txid" =: txid t] coll) (encodeZGoTxBson t)
 
--- | Main API function
-app ::
-     Pipe
-  -> T.Text
-  -> SecureMem
-  -> T.Text
-  -> Integer
-  -> Maybe TLSSettings
-  -> IO ()
-app pipe db passkey nodeAddress port tls = do
+-- | Main API routes
+routes :: Pipe -> T.Text -> SecureMem -> T.Text -> ScottyM ()
+routes pipe db passkey nodeAddress = do
   let run = access pipe master db
-  scotty 3000 $ do
   middleware $
     cors $
     const $
@@ -443,9 +434,7 @@ app pipe db passkey nodeAddress port tls = do
         status ok200
         Web.Scotty.json
           (object
-               [ "message" .= ("Items found!" :: String)
-               , "items" .= toJSON pItems
-               ])
+             ["message" .= ("Items found!" :: String), "items" .= toJSON pItems])
     --Upsert item
   post "/api/item" $ do
     i <- jsonData

zgo-backend.cabal

@@ -81,6 +81,7 @@ executable zgo-backend-exe
     , text
     , time
     , wai-extra
+    , warp
     , warp-tls
     , zgo-backend
   default-language: Haskell2010

zgo.cfg

@@ -5,5 +5,5 @@ dbUser = "zgo"
 dbPassword = "zcashrules"
 port = 3000
 tls = false
-cert = "/path/to/cert.pem"
+certificate = "/path/to/cert.pem"
 key = "/path/to/key.pem"