Record before big change

[Rakka.git] / Rakka / SystemConfig.hs

diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs
index 9e8be67c5bd59bf16cfdc9f56e12e02e5564dfaa..67603862d60b00fcfe7692f56a3f48b743ec3036 100644 (file)
--- 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
@@ -114,7 +115,7 @@ getSysConfA = arrIO0 . getSysConf
 
 
 fromConfPath :: FilePath -> FilePath
-fromConfPath = combine "/config"
+fromConfPath = ("/config" </>)
 
 
 serializeStringPairs :: [(String, String)] -> String
@@ -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
@@ -156,7 +163,7 @@ instance SysConfValue BaseURI where
                        PortNumber num -> fromIntegral num
 
               defaultURI
-                  = "http://" ++ host ++
+                  = "http://" ++ host ++ -- FIXME: consider IPv6 address
                     (if port == 80
                      then ""
                      else ':' : show port) ++ "/"