implemented global lock

[Rakka.git] / Rakka / SystemConfig.hs

diff --git a/Rakka/SystemConfig.hs b/Rakka/SystemConfig.hs
index 9e8be67c5bd59bf16cfdc9f56e12e02e5564dfaa..11fe124a155a62c4bcb4f8b4b28601f3804aca59 100644 (file)
--- a/Rakka/SystemConfig.hs
+++ b/Rakka/SystemConfig.hs
@@ -12,16 +12,21 @@ module Rakka.SystemConfig
     , DefaultPage(..)
     , StyleSheet(..)
     , Languages(..)
+    , GlobalLock(..)
+
+    , serializeStringPairs
+    , deserializeStringPairs
     )
     where
 
+import           Codec.Binary.UTF8.String
 import           Control.Arrow.ArrowIO
 import           Control.Concurrent.STM
+import           Control.Monad
 import           Control.Monad.Trans
 import qualified Data.ByteString.Char8 as C8
+import qualified Data.ByteString.Lazy  as L
 import           Data.Dynamic
-import           Data.Encoding
-import           Data.Encoding.UTF8
 import           Data.Map (Map)
 import qualified Data.Map as M
 import           Data.Maybe
@@ -29,7 +34,7 @@ import           GHC.Conc (unsafeIOToSTM)
 import           Network
 import qualified Network.HTTP.Lucu.Config as LC
 import           Network.HTTP.Lucu.Utils
-import           Network.URI
+import           Network.URI hiding (path)
 import           Rakka.Page
 import           Rakka.Utils
 import           Subversion.FileSystem
@@ -39,6 +44,8 @@ import           Subversion.Repository
 import           System.FilePath.Posix
 import           System.Log.Logger
 
+
+logger :: String
 logger = "Rakka.SystemConfig"
 
 
@@ -91,7 +98,7 @@ getSysConf' sc
                        case exists of
                          True
                              -> do str <- getFileContentsLBS path
-                                   return $ Just $ chomp $ decodeLazy UTF8 str
+                                   return $ Just $ chomp $ decode $ L.unpack str
                          False
                              -> return Nothing
 
@@ -114,7 +121,7 @@ getSysConfA = arrIO0 . getSysConf
 
 
 fromConfPath :: FilePath -> FilePath
-fromConfPath = combine "/config"
+fromConfPath = ("/config" </>)
 
 
 serializeStringPairs :: [(String, String)] -> String
@@ -148,15 +155,21 @@ 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
               port = case LC.cnfServerPort conf of
-                       PortNumber num -> fromIntegral num
-
+                       PortNumber num -> fromIntegral num :: Int
+                       _              -> undefined
               defaultURI
-                  = "http://" ++ host ++
+                  = "http://" ++ host ++ -- FIXME: consider IPv6 address
                     (if port == 80
                      then ""
                      else ':' : show port) ++ "/"
@@ -197,3 +210,15 @@ instance SysConfValue Languages where
                                  , ("pt", "Português")
                                  , ("sv", "Svenska"  )
                                  ]
+
+
+newtype GlobalLock = GlobalLock Bool deriving (Show, Typeable)
+instance SysConfValue GlobalLock where
+    confPath _      = "globalLock"
+    serialize (GlobalLock isLocked)
+        | isLocked  = "*"
+        | otherwise = ""
+    deserialize "*" = Just (GlobalLock True)
+    deserialize ""  = Just (GlobalLock False)
+    deserialize _   = Nothing
+    defaultValue _  = GlobalLock False