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)

1 files changed, 10 insertions, 0 deletions

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 =