yackage 0.1.0.1 → 0.2.0

raw patch · 3 files changed

+30/−31 lines, 3 filesdep +http-typesdep ~http-enumeratordep ~yesod-core

Dependencies added: http-types

Dependency ranges changed: http-enumerator, yesod-core

Files

• yackage-upload.hs +1/−1
• yackage.cabal +4/−3
• yackage.hs +25/−27

@@ -14,7 +14,7 @@                 [x, y] -> (x, "", y)                 [x, y, z] -> (x, y, z)                 _ -> error "Usage: yackage-upload <url> [password] <file>"-    req <- parseUrl $ S8.pack url+    req <- parseUrl url     body <- mkBody pass file     let req' = req             { method = "POST"

@@ -1,5 +1,5 @@ Name:                yackage-Version:             0.1.0.1+Version:             0.2.0 Synopsis:            Personal Hackage replacement for testing new packages. Description:     This package installs a yackage executable that runs a simplistic hackage-like server. It allows you to upload packages produced via cabal sdist and install them via cabal. The trick is to add the yackage repository to your cabal config file, with a line such as:@@ -27,7 +27,7 @@   Main-is:             yackage.hs   if flag(yackage)       Build-depends:       base >= 4 && < 5-                         , yesod-core >= 0.7 && < 0.8+                         , yesod-core >= 0.8 && < 0.9                          , warp                          , Cabal                          , bytestring@@ -43,6 +43,7 @@                          , transformers                          , hamlet                          , yesod-form+                         , http-types >= 0.6 && < 0.7   else     Buildable: False @@ -50,7 +51,7 @@   Main-is:             yackage-upload.hs   if flag(upload)       Build-depends:       base >= 4 && < 5-                         , http-enumerator >= 0.5.1 && < 0.6+                         , http-enumerator >= 0.6 && < 0.7                          , blaze-builder >= 0.2.1.3 && < 0.4                          , bytestring   else

@@ -38,7 +38,9 @@ import Control.Monad (join, unless) import System.Console.CmdArgs import Network.Wai-import Network.Wai.Handler.Warp (run)+import Network.Wai.Handler.Warp (runSettings, defaultSettings, settingsPort, settingsHost)+import Network.HTTP.Types (status403)+import qualified Data.Text as T  data Args = Args     { port :: Int@@ -70,16 +72,16 @@ tarballR pn v = TarballR $ tarballName pn v  tarballName pn v = concat-    [ toSinglePiece pn+    [ T.unpack $ toSinglePiece pn     , "-"-    , toSinglePiece v+    , T.unpack $ toSinglePiece v     , ".tar.gz"     ]  cabalName pn v = concat-    [ toSinglePiece pn+    [ T.unpack $ toSinglePiece pn     , "-"-    , toSinglePiece v+    , T.unpack $ toSinglePiece v     , ".cabal"     ] @@ -87,20 +89,20 @@     rd <- rootDir `fmap` getYesod     return $ concat         [ rd-        , '/' : toSinglePiece pn-        , '/' : toSinglePiece v+        , '/' : T.unpack (toSinglePiece pn)+        , '/' : T.unpack (toSinglePiece v)         ]  instance Yesod Yackage where approot _ = "" instance SinglePiece Version where     fromSinglePiece s =-        case filter (\(_, y) -> null y) $ readP_to_S parseVersion s of-            [] -> Left "Invalid version"-            (x, ""):_ -> Right x-    toSinglePiece = showVersion+        case filter (\(_, y) -> null y) $ readP_to_S parseVersion $ T.unpack s of+            [] -> Nothing+            (x, ""):_ -> Just x+    toSinglePiece = T.pack . showVersion instance SinglePiece PackageName where-    fromSinglePiece = Right . PackageName-    toSinglePiece = unPackageName+    fromSinglePiece = Just . PackageName . T.unpack+    toSinglePiece = T.pack . unPackageName  type Handler = GHandler Yackage Yackage @@ -111,7 +113,7 @@     defaultLayout $ do         setTitle $ string $ ytitle y         addHamlet [$hamlet|\-<h1>Yackage+<h1>#{ytitle y} <form method="post" enctype="multipart/form-data">     <div>         \Upload a new file: @@ -137,7 +139,7 @@         Nothing -> return ()         Just p -> do             p' <- runFormPost' $ maybeStringInput "password"-            unless (Just p == p') $ permissionDenied "Invalid password"+            unless (Just (T.pack p) == p') $ permissionDenied "Invalid password"     (_, files) <- runRequestBody     content <-         case lookup "file" files of@@ -211,15 +213,11 @@             else return $ Map.empty     m' <- liftIO $ newMVar m     app <- toWaiApp $ Yackage path m' (password args) (title args)-    let app' = if localhost args then onlyLocal app else app     putStrLn $ "Running Yackage on port " ++ show (port args) ++ ", rootdir: " ++ path-    run (port args) app'--onlyLocal app req =-    if takeWhile (/= ':') (show $ remoteHost req) `elem` ["127.0.0.1", "localhost"]-        then app req-        else return $ responseLBS status403 [("Content-Type", "text/plain")]-                    "This Yackage server only talks to local clients"+    runSettings defaultSettings+        { settingsPort = port args+        , settingsHost = if localhost args then "127.0.0.1" else "*"+        } app  unPackageName (PackageName s) = s @@ -242,8 +240,8 @@     go path (name, vs) = map (go' path name) $ Set.toList vs     go' path name version = concat         [ path-        , '/' : toSinglePiece name-        , '/' : toSinglePiece version+        , '/' : T.unpack (toSinglePiece name)+        , '/' : T.unpack (toSinglePiece version)         , '/' : cabalName name version         ] @@ -266,11 +264,11 @@   where     go :: (String, Object String String) -> Maybe (PackageName, Set Version)     go (name, vs) = do-        Right name' <- return $ fromSinglePiece name+        Just name' <- return $ fromSinglePiece $ T.pack name         vs' <- fromSequence vs         vs'' <- mapM go' vs'         return (name', Set.fromList vs'')     go' s = do         s' <- fromScalar s-        Right x <- return $ fromSinglePiece s'+        let Just x = fromSinglePiece $ T.pack s'         return x