-import Codec.Binary.Base64
import Codec.Compression.GZip
import Control.Monad
import Data.Bits
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as Lazy (ByteString)
-import qualified Data.ByteString.Lazy as L hiding (ByteString)
+import qualified Data.ByteString.Lazy as LS hiding (ByteString)
import Data.Char
-import Data.Digest.SHA2
import Data.Int
import Data.Maybe
import Data.Time
import Data.Time.Clock.POSIX
-import Data.Word
import Language.Haskell.Pretty
import Language.Haskell.Syntax
import Network.HTTP.Lucu.MIMEType
import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap
import Network.HTTP.Lucu.MIMEType.Guess
+import OpenSSL
+import OpenSSL.EVP.Digest
import System.Console.GetOpt
import System.Environment
import System.Exit
main :: IO ()
-main = do (opts, sources, errors) <- return . getOpt Permute options =<< getArgs
+main = withOpenSSL $
+ do (opts, sources, errors) <- return . getOpt Permute options =<< getArgs
- when (not $ null errors)
+ unless (null errors)
$ do mapM_ putStr errors
exitWith $ ExitFailure 1
- when (any (\ x -> x == OptHelp) opts)
+ when (any (== OptHelp) opts)
$ do printUsage
exitWith ExitSuccess
output <- openOutput opts
eTag <- getETag opts input
- let gzippedData = compressWith BestCompression input
- originalLen = L.length input
- gzippedLen = L.length gzippedData
+ let compParams = defaultCompressParams { compressLevel = bestCompression }
+ gzippedData = compressWith compParams input
+ originalLen = LS.length input
+ gzippedLen = LS.length gzippedData
useGZip = originalLen > gzippedLen
- rawB64 = encode $ L.unpack input
- gzippedB64 = encode $ L.unpack gzippedData
+ rawB64 = B64.encode $ BS.concat $ LS.toChunks input
+ gzippedB64 = B64.encode $ BS.concat $ LS.toChunks gzippedData
header <- mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod
let hsModule = HsModule undefined (Module modName) (Just exports) imports decls
exports = [HsEVar (UnQual (HsIdent symName))]
- imports = [ HsImportDecl undefined (Module "Codec.Binary.Base64")
- False Nothing Nothing
+ imports = [ HsImportDecl undefined (Module "Data.ByteString.Base64")
+ True (Just (Module "B64")) Nothing
+ , HsImportDecl undefined (Module "Data.ByteString.Char8")
+ True (Just (Module "C8")) Nothing
, HsImportDecl undefined (Module "Data.ByteString.Lazy")
- True (Just (Module "L")) Nothing
- , HsImportDecl undefined (Module "Data.Maybe")
- False Nothing Nothing
+ True (Just (Module "LS")) Nothing
, HsImportDecl undefined (Module "Data.Time")
False Nothing Nothing
, HsImportDecl undefined (Module "Network.HTTP.Lucu")
declGZippedData
= [ HsTypeSig undefined [HsIdent "gzippedData"]
(HsQualType []
- (HsTyCon (Qual (Module "L") (HsIdent "ByteString"))))
+ (HsTyCon (Qual (Module "LS") (HsIdent "ByteString"))))
, HsFunBind [HsMatch undefined (HsIdent "gzippedData")
[] (HsUnGuardedRhs defGZippedData) []]
]
defGZippedData :: HsExp
defGZippedData
- = HsApp (HsVar (Qual (Module "L") (HsIdent "pack")))
- (HsParen
- (HsApp (HsVar (UnQual (HsIdent "fromJust")))
- (HsParen
- (HsApp (HsVar (UnQual (HsIdent "decode")))
- (HsLit (HsString gzippedB64))))))
+ = HsApp (HsVar (Qual (Module "LS") (HsIdent "fromChunks")))
+ (HsList [HsApp (HsVar (Qual (Module "B64") (HsIdent "decodeLenient")))
+ (HsParen
+ (HsApp (HsVar (Qual (Module "C8") (HsIdent "pack")))
+ (HsLit (HsString $ C8.unpack gzippedB64))))])
declRawData :: [HsDecl]
declRawData
= [ HsTypeSig undefined [HsIdent "rawData"]
(HsQualType []
- (HsTyCon (Qual (Module "L") (HsIdent "ByteString"))))
+ (HsTyCon (Qual (Module "LS") (HsIdent "ByteString"))))
, HsFunBind [HsMatch undefined (HsIdent "rawData")
[] (HsUnGuardedRhs defRawData) []]
]
defRawData :: HsExp
defRawData
- = HsApp (HsVar (Qual (Module "L") (HsIdent "pack")))
- (HsParen
- (HsApp (HsVar (UnQual (HsIdent "fromJust")))
- (HsParen
- (HsApp (HsVar (UnQual (HsIdent "decode")))
- (HsLit (HsString rawB64))))))
+ = HsApp (HsVar (Qual (Module "LS") (HsIdent "fromChunks")))
+ (HsList [HsApp (HsVar (Qual (Module "B64") (HsIdent "decodeLenient")))
+ (HsParen
+ (HsApp (HsVar (Qual (Module "C8") (HsIdent "pack")))
+ (HsLit (HsString $ C8.unpack rawB64))))])
hPutStrLn output header
hPutStrLn output (prettyPrint hsModule)
_ -> False) opts
-- モジュール名をピリオドで分割した時の最後の項目の先頭文字を
-- 小文字にしたものを使ふ。
- defaultSymName = mkDefault modName
- mkDefault = headToLower . getLastComp
- headToLower = \ str -> case str of
- [] -> error "module name must not be empty"
- (x:xs) -> toLower x : xs
- getLastComp = reverse . fst . break (== '.') . reverse
+ defaultSymName = mkDefault modName
+ mkDefault = headToLower . getLastComp
+ headToLower str = case str of
+ [] -> error "module name must not be empty"
+ (x:xs) -> toLower x : xs
+ getLastComp = reverse . fst . break (== '.') . reverse
in
case symNameOpts of
[] -> return defaultSymName
getLastModified :: FilePath -> IO UTCTime
getLastModified "-" = getCurrentTime
-getLastModified fpath = getFileStatus fpath
- >>= return . posixSecondsToUTCTime . fromRational . toRational . modificationTime
+getLastModified fpath = fmap (posixSecondsToUTCTime . fromRational . toRational . modificationTime)
+ $ getFileStatus fpath
getETag :: [CmdOpt] -> Lazy.ByteString -> IO String
_ -> False) opts
in
case eTagOpts of
- [] -> return mkETagFromInput
+ [] -> fmap (mkETagFromInput . fromJust) (getDigestByName "SHA1")
(OptETag str):[] -> return str
_ -> error "too many --etag options."
where
- mkETagFromInput :: String
- mkETagFromInput = "SHA-1:" ++ (toHex $ toOctets $ sha256 $ L.unpack input)
+ mkETagFromInput :: Digest -> String
+ mkETagFromInput sha1 = "SHA-1:" ++ toHex (digestLBS sha1 input)
- toHex :: [Word8] -> String
- toHex [] = ""
- toHex (x:xs) = hexByte (fromIntegral x) ++ toHex xs
+ toHex :: String -> String
+ toHex = foldr ((++) . hexByte . fromEnum) ""
hexByte :: Int -> String
hexByte n
- = hex4bit ((n `shiftR` 4) .&. 0x0F) : hex4bit (n .&. 0x0F) : []
+ = [ hex4bit ((n `shiftR` 4) .&. 0x0F)
+ , hex4bit ( n .&. 0x0F)
+ ]
hex4bit :: Int -> Char
hex4bit n
- | n < 10 = (chr $ ord '0' + n )
- | n < 16 = (chr $ ord 'a' + n - 10)
+ | n < 10 = chr $ ord '0' + n
+ | n < 16 = chr $ ord 'a' + n - 10
| otherwise = undefined
openInput :: FilePath -> IO Lazy.ByteString
-openInput "-" = L.getContents
-openInput fpath = L.readFile fpath
+openInput "-" = LS.getContents
+openInput fpath = LS.readFile fpath
openOutput :: [CmdOpt] -> IO Handle
Last Modified: 2007-11-05 13:53:42.231882 JST
-}
module Foo.Bar.Baz (baz) where
- import Codec.Binary.Base64
- import qualified Data.ByteString.Lazy as L
- import Data.Maybe
+ import qualified Data.ByteString.Base64 as B64
+ import qualified Data.ByteString.Char8 as C8
+ import qualified Data.ByteString.Lazy as LS
import Data.Time
import Network.HTTP.Lucu
contentType :: MIMEType
contentType = read "image/png"
- rawData :: L.ByteString
- rawData = L.pack (fromJust (decode "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ..."))
+ rawData :: LS.ByteString
+ rawData = LS.fromChunks [B64.decodeLenient (C8.pack "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ...")]
------------------------------------------------------------------------------
壓縮される場合は次のやうに變はる:
}
-- rawData の代はりに gzippedData
- gzippedData :: L.ByteString
- gzippedData = L.pack (fromJust (decode "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB..."))
+ gzippedData :: LS.ByteString
+ gzippedData = LS.fromChunks [B64.decodeLenient (C8.pack "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB...")]
------------------------------------------------------------------------------
-}
projects / Lucu.git / blobdiff