orchid-demo 0.0.4 → 0.0.5

raw patch · 3 files changed

+46/−35 lines, 3 filesdep +extensible-exceptionsdep ~orchiddep ~salvia

Dependencies added: extensible-exceptions

Dependency ranges changed: orchid, salvia

Files

• data.zip binary
• orchid-demo.cabal +4/−3
• src/Demo.hs +42/−32

binary file changed (75528 → 73687 bytes)

@@ -1,5 +1,5 @@ Name:             orchid-demo-Version:          0.0.4+Version:          0.0.5 Description:      Haskell Wiki Demo Synopsis:         Haskell Wiki Demo Category:         Network, Web@@ -10,8 +10,9 @@ Build-Type:       Simple Build-Depends:    base,                   network,-                  salvia ==0.0.4,-                  orchid ==0.0.6,+                  extensible-exceptions,+                  salvia ==0.0.5,+                  orchid ==0.0.7,                   mtl ==1.1.0.2,                   Pipe,                   stm

@@ -1,24 +1,22 @@ module Main where  import Control.Concurrent.STM+import Control.Exception.Extensible import Control.Monad (when)-import Control.Exception-import System.Exit-import System.IO-import System.Environment-import System.Console.GetOpt-import System.Process.Pipe-import Network.Socket (PortNumber, inet_addr)-+import Network.Orchid.Wiki (hWiki, FileStoreType (..)) import Network.Protocol.Uri (jail)+import Network.Salvia.Advanced.ExtendedFileSystem (hExtendedFileSystem) import Network.Salvia.Handlers.Default (hDefault) import Network.Salvia.Handlers.Login (readUserDatabase, UserPayload) import Network.Salvia.Handlers.Session (mkSessions, Sessions)-import Network.Salvia.Advanced.ExtendedFileSystem (hExtendedFileSystem) import Network.Salvia.Httpd (defaultConfig, start, listenAddr, listenPort)-import Network.Orchid.Wiki (hWiki)-+import Network.Socket (PortNumber, inet_addr) import Paths_orchid_demo+import System.Console.GetOpt+import System.Environment+import System.Exit+import System.IO+import System.Process.Pipe  ------------------------------------------------------------------------------- @@ -34,17 +32,21 @@    -- Run web server with wiki.   run-    (asServer conf)-    (bindAddr conf)-    (bindPort conf)-    (dataDir  conf)-    (userDB   conf)+    (asServer  conf)+    (filestore conf)+    (bindAddr  conf)+    (bindPort  conf)+    (dataDir   conf)+    (userDB    conf)  -------- wiki server ---------------------------------------------------------- -run :: Bool -> String -> PortNumber -> FilePath -> FilePath -> IO ()-run serve address port dir users = do+stringToFileStore :: String -> Maybe FileStoreType+stringToFileStore kind = lookup kind [("Darcs", Darcs), ("Git", Git)] +run :: Bool -> String -> String -> PortNumber -> FilePath -> FilePath -> IO ()+run serve sfs address port dir users = do+   -- Initialize global state.   db       <- readUserDatabase users   ioconfig <- defaultConfig @@ -52,24 +54,28 @@   sessions <- mkSessions :: IO (Sessions (UserPayload ()))   addr     <- inet_addr address -  -- Alter config and setup handler.-  let config    = ioconfig { listenAddr = addr, listenPort = port }-  let myHandler = if serve-                   then const $ hExtendedFileSystem dir-                   else hWiki dir dir db+  case stringToFileStore sfs of+    Nothing -> putStrLn $ "Error: No such filestore: " ++ sfs+    Just fs -> do -  -- Warn about serving user database.-  when (maybe False (const True) (jail dir users))-    $ putStrLn "Warning: serving user database to the evil outside world."+      -- Alter config and setup handler.+      let config    = ioconfig { listenAddr = addr, listenPort = port }+      let myHandler = if serve+                       then const $ hExtendedFileSystem dir+                       else hWiki fs dir dir db -  -- Print status messages and..-  putStrLn $ concat ["Listening on ", address, ":", show (listenPort config), "."]-  putStrLn $ concat ["Using ", dir, " as wiki repository."]+      -- Warn about serving user database.+      when (maybe False (const True) (jail dir users))+        $ putStrLn "Warning: serving user database to the evil outside world." -  -- ..off we go!-  putStrLn "Server started."-  start config $ hDefault count sessions myHandler+      -- Print status messages and..+      putStrLn $ concat ["Listening on ", address, ":", show (listenPort config), "."]+      putStrLn $ concat ["Using ", dir, " as wiki repository."] +      -- ..off we go!+      putStrLn "Server started."+      start config $ hDefault count sessions myHandler+ extractArchive :: FilePath -> FilePath -> IO () extractArchive from to = do   putStrLn $ concat ["Extracting repository from ", from, " to ", to, "."]@@ -88,6 +94,7 @@   , dataDir     :: String   , userDB      :: String   , asServer    :: Bool+  , filestore   :: String   , bindAddr    :: String   , bindPort    :: PortNumber   } deriving Show@@ -104,6 +111,7 @@     , dataDir     = "/tmp/data"     , userDB      = "/tmp/data/_user.db"     , asServer    = False+    , filestore   = "Darcs"     , bindAddr    = "0.0.0.0"     , bindPort    = 8080     } @@ -118,6 +126,7 @@     optDataDir     = OptArg (maybe id (\a c -> c { dataDir     = a    })) "/tmp/data"     optUserDB      = OptArg (maybe id (\a c -> c { userDB      = a    })) "/tmp/data/_user.db"     optAsServer    = NoArg            (\  c -> c { asServer    = True }) +    optFileStore   = OptArg (maybe id (\a c -> c { filestore   = a    })) "Darcs"     optBindAddr    = OptArg (maybe id (\a c -> c { bindAddr    = a    })) "0.0.0.0"     optBindPort    = OptArg (maybe id (\a c -> c { bindPort    = fromIntegral (read a :: Int) })) "8080"   in [@@ -127,6 +136,7 @@   , Option [] ["data-dir"]   optDataDir     "run demo with this repository"   , Option [] ["user-db"]    optUserDB      "location of user database file"   , Option [] ["as-server"]  optAsServer    "do not start wiki but serve directory"+  , Option [] ["filestore"]  optFileStore   "filestore type: Darcs or Git"   , Option [] ["address"]    optBindAddr    "address to listen on"   , Option [] ["port"]       optBindPort    "port to bind to"   ]