summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorqinka <>2017-12-01 12:50:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-12-01 12:50:00 (GMT)
commit7753fca74b38aec8183da89f296e6ac93a821447 (patch)
tree1f8b927c9199c74d74999677b1a3150a55c5d0f4
parentfd08bc84a89a85f9314c45c880a96edb7b0ea82e (diff)
version 0.1.0.60.1.0.6
-rw-r--r--src/Main.hs24
-rw-r--r--src/Yu/Launch.hs30
-rw-r--r--src/Yu/Launch/Internal.hs56
-rw-r--r--yu-launch.cabal2
4 files changed, 62 insertions, 50 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 2383271..bc9c5e7 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -14,20 +14,30 @@ import qualified Yu.Import.ByteString as B
import qualified Yu.Import.ByteString.Lazy as BL
import qualified Yu.Import.Text as T
import Yu.Launch
+import Paths_yu_launch
main :: IO ()
main = do
- rain <- createXiao =<< parseCfgFile <$> getContents
- case rain of
- Just r@Xiao{..} -> warp rainPort r
+ xiao <- createXiao =<< parseCfgFile <$> fetchConfig
+ case xiao of
+ Just x@Xiao{..} -> warp xiaoPort x
_ -> hPutStrLn stderr "can not parse"
return ()
-parseCfgFileJSON :: String -> Maybe [XiaoConfig]
+fetchConfig :: IO String
+fetchConfig = do
+ cfg1 <- getContents
+ etcP <- getSysconfDir
+ if null cfg1
+ then readFile $ etcP ++ "/xiao/config"
+ else return cfg1
+
+
+parseCfgFileJSON :: String -> Maybe XiaoConfigServer
parseCfgFileJSON str = A.decode $ BL.pack str
-parseCfgFileYAML :: String -> Maybe [XiaoConfig]
+parseCfgFileYAML :: String -> Maybe XiaoConfigServer
parseCfgFileYAML str = Y.decode $ B.pack str
-parseCfgFile :: String -> [XiaoConfig]
-parseCfgFile str = fromMaybe [] $ parseCfgFileYAML str <|> parseCfgFileJSON str
+parseCfgFile :: String -> Maybe XiaoConfigServer
+parseCfgFile str = parseCfgFileYAML str <|> parseCfgFileJSON str
diff --git a/src/Yu/Launch.hs b/src/Yu/Launch.hs
index 459cfff..1e84626 100644
--- a/src/Yu/Launch.hs
+++ b/src/Yu/Launch.hs
@@ -17,25 +17,25 @@ import System.IO
import Yesod.Core.Dispatch
import Yu.Core.Control
import Yu.Core.Model
-import qualified Yu.Import.Text as T
+import qualified Yu.Import.ByteString as B
+import qualified Yu.Import.Text as T
import Yu.Launch.Internal
mkYesodDispatch "Xiao" resourcesXiao
-createXiao :: [XiaoConfig]
+createXiao :: Maybe XiaoConfigServer
-> IO (Maybe Xiao)
-createXiao rcs = do
- case (filter rainConfigIsServer rcs, filter (not.rainConfigIsServer) rcs) of
- (RCServer{..}:_,RCDatabase{..}:_) -> do
- cp <- createPool (connect $ readHostPort rcdDBAddr) close 10 20 1000
- return $ Just $ Xiao { rainTitle = rcsTitle
- , rainDb = rcdDB
- , rainDBUP = (T.pack rcdUser,T.pack rcdPass)
- , rainConnPool = cp
- , rainPort = rcsPort
- }
- _ -> do
- hPutStrLn stderr "invaild config"
- return Nothing
+createXiao Nothing = return Nothing
+createXiao (Just xc) = do
+ let XCS{..} = xc
+ XCD{..} = xcsDB
+ cp <- createPool (connect $ readHostPort xcdHost) close 10 20 1000
+ return $ Just $ Xiao { xiaoTitle = xcsTitle
+ , xiaoDb = xcdName
+ , xiaoDBUP = (T.pack xcdUser,T.pack xcdPass)
+ , xiaoConnPool = cp
+ , xiaoPort = xcsPort
+ , xiaoKey = B.pack xcsKey
+ }
diff --git a/src/Yu/Launch/Internal.hs b/src/Yu/Launch/Internal.hs
index 22b362d..d893668 100644
--- a/src/Yu/Launch/Internal.hs
+++ b/src/Yu/Launch/Internal.hs
@@ -9,10 +9,10 @@
module Yu.Launch.Internal
( Xiao(..)
- , XiaoConfig(..)
+ , XiaoConfigServer(..)
+ , XiaoConfigDatabase(..)
, Route(..)
, resourcesXiao
- , rainConfigIsServer
) where
import Control.Monad.IO.Class
@@ -39,28 +39,30 @@ import qualified Yu.Utils.Info as UInfo
-- | basic config
-data XiaoConfig = RCServer
- { rcsPort :: Int
- , rcsTitle :: T.Text
- }
- | RCDatabase
- { rcdDB :: T.Text
- , rcdDBAddr :: String
- , rcdUser :: String
- , rcdPass :: String
- }
- deriving (Show,Eq)
-deriveJSON defaultOptions ''XiaoConfig
-rainConfigIsServer :: XiaoConfig -> Bool
-rainConfigIsServer RCServer{..} = True
-rainConfigIsServer RCDatabase{..} = False
+data XiaoConfigServer = XCS
+ { xcsPort :: Int
+ , xcsTitle :: T.Text
+ , xcsKey :: String
+ , xcsDB :: XiaoConfigDatabase
+ }
+ deriving (Show,Eq)
+data XiaoConfigDatabase = XCD
+ { xcdName :: T.Text
+ , xcdHost :: String
+ , xcdUser :: String
+ , xcdPass :: String
+ }
+ deriving (Show,Eq)
+deriveJSON defaultOptions {fieldLabelModifier = map toLower . drop 3 } ''XiaoConfigServer
+deriveJSON defaultOptions {fieldLabelModifier = map toLower . drop 3} ''XiaoConfigDatabase
-data Xiao = Xiao { rainTitle :: T.Text
- , rainDb :: T.Text
- , rainDBUP :: (T.Text, T.Text)
- , rainConnPool :: ConnectionPool
- , rainPort :: Int
+data Xiao = Xiao { xiaoTitle :: T.Text
+ , xiaoDb :: T.Text
+ , xiaoDBUP :: (T.Text, T.Text)
+ , xiaoConnPool :: ConnectionPool
+ , xiaoPort :: Int
+ , xiaoKey :: B.ByteString
}
mkYesodData "Xiao" [parseRoutes| /*Texts UrlR GET PUT DELETE |]
@@ -80,19 +82,19 @@ instance Yesod Xiao where
maximumContentLength _ _ = Nothing
instance Auth Xiao SHA256 where
- tokenItem _ = liftIO $ B.pack <$> getEnv "RAIN_ENV"
+ tokenItem x = return $ xiaoKey x
tokenHash _ = return SHA256
instance Hamletic Xiao (HandlerT Xiao IO) where
- getTitle = rainTitle <$> getYesod
+ getTitle = xiaoTitle <$> getYesod
getFramePrefix = return ".frame"
getVersion = return $(stringE (show version))
getRaw = return False
instance Mongodic Xiao (HandlerT Xiao IO) where
getDefaultAccessMode = return master
- getDefaultDb = rainDb <$> getYesod
- getDbUP = rainDBUP <$> getYesod
- getPool = rainConnPool <$> getYesod
+ getDefaultDb = xiaoDb <$> getYesod
+ getDbUP = xiaoDBUP <$> getYesod
+ getPool = xiaoConnPool <$> getYesod
instance Controly Xiao
diff --git a/yu-launch.cabal b/yu-launch.cabal
index fb8f6f6..dd382a7 100644
--- a/yu-launch.cabal
+++ b/yu-launch.cabal
@@ -2,7 +2,7 @@
-- documentation, see http://haskell.org/cabal/users-guide/
name: yu-launch
-version: 0.1.0.0
+version: 0.1.0.6
synopsis: The launcher for Yu.
description: The launcher for Yu.
homepage: https://github.com/Qinka/Yu