From 62881e3a58ee1e26594eb1ecbca0adbdc4deb030 Mon Sep 17 00:00:00 2001
From: Jon Schoning <jonschoning@gmail.com>
Date: Tue, 26 Apr 2022 20:54:25 -0500
Subject: [PATCH] add setting ALLOW_NON_HTTP_URL_SCHEMES (default false)

- adds ability to enable app url scheems
---
 changelog.md        | 3 +++
 config/settings.yml | 2 ++
 docker-compose.yml  | 6 ++++--
 espial.cabal        | 2 +-
 package.yaml        | 2 +-
 src/Handler/Add.hs  | 9 +++++----
 src/Settings.hs     | 4 ++++
 7 files changed, 20 insertions(+), 8 deletions(-)

diff --git a/changelog.md b/changelog.md
index 07bf09c..6daaaad 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,6 @@
+__v0.0.13__
+add setting ALLOW_NON_HTTP_URL_SCHEMES (default false)
+
 __v0.0.12__
 update to ghc9
 
diff --git a/config/settings.yml b/config/settings.yml
index 7b708a2..b55c89f 100644
--- a/config/settings.yml
+++ b/config/settings.yml
@@ -43,3 +43,5 @@ archive-socks-proxy-port: "_env:ARCHIVE_SOCKS_PROXY_PORT"
 source-code-uri: "_env:SOURCE_CODE_URI:https://github.com/jonschoning/espial"
 
 ssl-only: "_env:SSL_ONLY" # false
+
+allow-non-http-url-schemes: "_env:ALLOW_NON_HTTP_URL_SCHEMES:false"
diff --git a/docker-compose.yml b/docker-compose.yml
index 77485c6..3db0065 100644
--- a/docker-compose.yml
+++ b/docker-compose.yml
@@ -13,8 +13,10 @@ services:
     environment:
       - IP_FROM_HEADER=true
       - SQLITE_DATABASE=/app/data/espial.sqlite3
-      # - DETAILED_LOGGING=true
-      # - SHOULD_LOG_ALL=true
+      # - SSL_ONLY=false
+      # - DETAILED_LOGGING=false
+      # - SHOULD_LOG_ALL=false
       # - ARCHIVE_SOCKS_PROXY_HOST=localhost 
       # - ARCHIVE_SOCKS_PROXY_PORT=8888
       # - SOURCE_CODE_URI=https://github.com/jonschoning/espial
+      # - ALLOW_NON_HTTP_URL_SCHEMES=false
diff --git a/espial.cabal b/espial.cabal
index 5e0e23e..78d5834 100644
--- a/espial.cabal
+++ b/espial.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           espial
-version:        0.0.12
+version:        0.0.13
 synopsis:       Espial is an open-source, web-based bookmarking server.
 description:    .
                 Espial is an open-source, web-based bookmarking server.
diff --git a/package.yaml b/package.yaml
index 6c2b7a0..dbba2ab 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,6 +1,6 @@
 name:    espial
 synopsis: Espial is an open-source, web-based bookmarking server.
-version: "0.0.12"
+version: "0.0.13"
 description: ! '
 
   Espial is an open-source, web-based bookmarking server.
diff --git a/src/Handler/Add.hs b/src/Handler/Add.hs
index 7c0e64e..8d26174 100644
--- a/src/Handler/Add.hs
+++ b/src/Handler/Add.hs
@@ -68,16 +68,17 @@ postAddR = do
 _handleFormSuccess :: BookmarkForm -> Handler (UpsertResult (Key Bookmark))
 _handleFormSuccess bookmarkForm = do
   (userId, user) <- requireAuthPair
-  case (parseRequest . unpack . _url) bookmarkForm of
-    Nothing -> pure $ Failed "Invalid URL"
-    Just _ -> do
+  appSettings <- appSettings <$> getYesod
+  case (appAllowNonHttpUrlSchemes appSettings, (parseRequest . unpack . _url) bookmarkForm) of
+    (False, Nothing) -> pure $ Failed "Invalid URL"
+    (_, _) -> do
       let mkbid = BookmarkKey <$> _bid bookmarkForm
           tags = maybe [] (nub . words . T.replace "," " ") (_tags bookmarkForm)
       bm <- liftIO $ _toBookmark userId bookmarkForm
       res <- runDB (upsertBookmark userId mkbid bm tags)
       forM_ (maybeUpsertResult res) $ \kbid ->
         whenM (shouldArchiveBookmark user kbid) $
-          void $ async (archiveBookmarkUrl kbid (unpack (bookmarkHref bm)))
+        void $ async (archiveBookmarkUrl kbid (unpack (bookmarkHref bm)))
       pure res
 
 postLookupTitleR :: Handler ()
diff --git a/src/Settings.hs b/src/Settings.hs
index 100258e..a4493ec 100644
--- a/src/Settings.hs
+++ b/src/Settings.hs
@@ -66,6 +66,8 @@ data AppSettings = AppSettings
     -- ^ Uri to app source code
 
     , appSSLOnly :: Bool
+
+    , appAllowNonHttpUrlSchemes :: Bool
     }
 
 instance FromJSON AppSettings where
@@ -102,6 +104,8 @@ instance FromJSON AppSettings where
 
         appSSLOnly                 <- fromMaybe False <$> o .:? "ssl-only"
 
+        appAllowNonHttpUrlSchemes  <- fromMaybe False <$> o .:? "allow-non-http-url-schemes"
+
         return AppSettings {..}
 
 -- | Settings for 'widgetFile', such as which template languages to support and