From 321f4d5fa118515dcde522e1ad01ddd65741828b Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Fri, 19 Nov 2021 01:29:28 +0100
Subject: add domain allow- and blocklists for weblinks

(these use a rather crude regex for parsing, which may be possible to
side-step, and which should probably be replaced by something that was
actually written while following the relevant rfc)
---
 lib/Paths.hs | 10 ++++++++++
 1 file changed, 10 insertions(+)

(limited to 'lib/Paths.hs')

diff --git a/lib/Paths.hs b/lib/Paths.hs
index af66e77..4082268 100644
--- a/lib/Paths.hs
+++ b/lib/Paths.hs
@@ -17,6 +17,16 @@ import           Util                  (PrettyPrint (prettyprint))
 data RelPath = Path Int Text (Maybe Text)
   deriving (Show, Eq, Ord)
 
+
+extractDomain :: Text -> Maybe Text
+extractDomain url =
+  let (_,_,_,matches) = url =~ ("^https://([^/]+)/?.*$" :: Text) :: (Text,Text,Text,[Text])
+  in case matches of
+      [domain] -> Just domain
+      _ -> Nothing
+
+
+
 -- | horrible regex parsing for filepaths that is hopefully kinda safe
 parsePath :: Text -> Maybe RelPath
 parsePath text =
-- 
cgit v1.2.3