X-Git-Url: https://git.cielonegro.org/gitweb.cgi?a=blobdiff_plain;f=Rakka%2FSystemConfig.hs;h=67603862d60b00fcfe7692f56a3f48b743ec3036;hb=fa3a9d0aecede2431e669ef33885a116f7d5f0be;hp=09c45166530dfc4b5f53fe700ff6aeec0aa0543f;hpb=56ac43ac34e79355f85dd7e413713c329ab0f166;p=Rakka.git

diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs
index 09c4516..6760386 100644
--- a/Rakka/SystemConfig.hs
+++ b/Rakka/SystemConfig.hs
@@ -17,6 +17,7 @@ module Rakka.SystemConfig
 
 import           Control.Arrow.ArrowIO
 import           Control.Concurrent.STM
+import           Control.Monad
 import           Control.Monad.Trans
 import qualified Data.ByteString.Char8 as C8
 import           Data.Dynamic
@@ -148,7 +149,13 @@ newtype BaseURI = BaseURI URI deriving (Show, Typeable)
 instance SysConfValue BaseURI where
     confPath _              = "baseURI"
     serialize (BaseURI uri) = uriToString id uri ""
-    deserialize uri         = fmap BaseURI (parseURI uri)
+    deserialize uri         = fmap BaseURI
+                              $ do parsed <- parseURI uri
+                                   when (uriPath parsed        == "" ) (fail undefined)
+                                   when (last (uriPath parsed) /= '/') (fail undefined)
+                                   when (uriQuery parsed       /= "" ) (fail undefined)
+                                   when (uriFragment parsed    /= "" ) (fail undefined)
+                                   return parsed
     defaultValue sc
         = let conf = scLucuConf sc
               host = C8.unpack $ LC.cnfServerHost conf