import Codec.Compression.GZip
import Control.Monad
import Data.Bits
-import Data.ByteString.Base (LazyByteString)
-import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy as Lazy (ByteString)
+import qualified Data.ByteString.Lazy as L hiding (ByteString)
import Data.Char
-import Data.Digest.SHA1
import Data.Int
import Data.Maybe
-import Data.Word
+import Data.Time
+import Data.Time.Clock.POSIX
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.Directory
import System.Environment
import System.Exit
+import System.Posix.Files
import System.IO
-import System.Time
data CmdOpt
= OptOutput FilePath
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)
$ do mapM_ putStr errors
output <- openOutput opts
eTag <- getETag opts input
- let gzippedData = compressWith BestCompression input
+ let compParams = defaultCompressParams { compressLevel = BestCompression }
+ gzippedData = compressWith compParams input
originalLen = L.length input
gzippedLen = L.length gzippedData
useGZip = originalLen > gzippedLen
rawB64 = encode $ L.unpack input
gzippedB64 = encode $ L.unpack gzippedData
- header = mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod
+ header <- mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod
- hsModule = HsModule undefined (Module modName) (Just exports) imports decls
+ 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
- , HsImportDecl undefined (Module "Data.ByteString.Base")
- False Nothing (Just (False, [HsIVar (HsIdent "LazyByteString")]))
, HsImportDecl undefined (Module "Data.ByteString.Lazy")
True (Just (Module "L")) Nothing
- , HsImportDecl undefined (Module "Network.HTTP.Lucu")
+ , HsImportDecl undefined (Module "Data.Maybe")
+ False Nothing Nothing
+ , HsImportDecl undefined (Module "Data.Time")
False Nothing Nothing
- , HsImportDecl undefined (Module "System.Time")
+ , HsImportDecl undefined (Module "Network.HTTP.Lucu")
False Nothing Nothing
]
++
declLastModified
= [ HsTypeSig undefined [HsIdent "lastModified"]
(HsQualType []
- (HsTyCon (UnQual (HsIdent "ClockTime"))))
+ (HsTyCon (UnQual (HsIdent "UTCTime"))))
, HsFunBind [HsMatch undefined (HsIdent "lastModified")
[] (HsUnGuardedRhs defLastModified) []]
]
defLastModified :: HsExp
defLastModified
- = let TOD a b = lastMod
- in
- (HsApp (HsApp (HsCon (UnQual (HsIdent "TOD")))
- (HsLit (HsInt a)))
- (HsLit (HsInt b)))
+ = HsApp (HsVar (UnQual (HsIdent "read")))
+ (HsLit (HsString $ show lastMod))
declContentType :: [HsDecl]
declGZippedData
= [ HsTypeSig undefined [HsIdent "gzippedData"]
(HsQualType []
- (HsTyCon (UnQual (HsIdent "LazyByteString"))))
+ (HsTyCon (Qual (Module "L") (HsIdent "ByteString"))))
, HsFunBind [HsMatch undefined (HsIdent "gzippedData")
[] (HsUnGuardedRhs defGZippedData) []]
]
defGZippedData
= HsApp (HsVar (Qual (Module "L") (HsIdent "pack")))
(HsParen
- (HsApp (HsVar (UnQual (HsIdent "decode")))
- (HsLit (HsString gzippedB64))))
+ (HsApp (HsVar (UnQual (HsIdent "fromJust")))
+ (HsParen
+ (HsApp (HsVar (UnQual (HsIdent "decode")))
+ (HsLit (HsString gzippedB64))))))
declRawData :: [HsDecl]
declRawData
= [ HsTypeSig undefined [HsIdent "rawData"]
(HsQualType []
- (HsTyCon (UnQual (HsIdent "LazyByteString"))))
+ (HsTyCon (Qual (Module "L") (HsIdent "ByteString"))))
, HsFunBind [HsMatch undefined (HsIdent "rawData")
[] (HsUnGuardedRhs defRawData) []]
]
defRawData
= HsApp (HsVar (Qual (Module "L") (HsIdent "pack")))
(HsParen
- (HsApp (HsVar (UnQual (HsIdent "decode")))
- (HsLit (HsString rawB64))))
+ (HsApp (HsVar (UnQual (HsIdent "fromJust")))
+ (HsParen
+ (HsApp (HsVar (UnQual (HsIdent "decode")))
+ (HsLit (HsString rawB64))))))
hPutStrLn output header
hPutStrLn output (prettyPrint hsModule)
hClose output
-mkHeader :: FilePath -> Int64 -> Int64 -> Bool -> MIMEType -> String -> ClockTime -> String
+mkHeader :: FilePath -> Int64 -> Int64 -> Bool -> MIMEType -> String -> UTCTime -> IO String
mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod
- = "{- DO NOT EDIT THIS FILE.\n" ++
- " This file is automatically generated by the lucu-implant-file program.\n" ++
- "\n" ++
- " Source: " ++ (if srcFile == "-"
- then "(stdin)"
- else srcFile) ++ "\n" ++
- " Original Length: " ++ show originalLen ++ " bytes\n" ++
- (if useGZip
- then " Compressed Length: " ++ show gzippedLen ++ " bytes\n" ++
- " Compression: gzip\n"
- else " Compression: disabled\n") ++
- " MIME Type: " ++ show mimeType ++ "\n" ++
- " ETag: " ++ eTag ++ "\n" ++
- " Last Modified: " ++ show lastMod ++ "\n" ++
- " -}"
+ = do localLastMod <- utcToLocalZonedTime lastMod
+ return ("{- DO NOT EDIT THIS FILE.\n" ++
+ " This file is automatically generated by the lucu-implant-file program.\n" ++
+ "\n" ++
+ " Source: " ++ (if srcFile == "-"
+ then "(stdin)"
+ else srcFile) ++ "\n" ++
+ " Original Length: " ++ show originalLen ++ " bytes\n" ++
+ (if useGZip
+ then " Compressed Length: " ++ show gzippedLen ++ " bytes\n" ++
+ " Compression: gzip\n"
+ else " Compression: disabled\n") ++
+ " MIME Type: " ++ show mimeType ++ "\n" ++
+ " ETag: " ++ eTag ++ "\n" ++
+ " Last Modified: " ++ show localLastMod ++ "\n" ++
+ " -}")
getModuleName :: [CmdOpt] -> IO String
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
_ -> error "too many --mime-type options."
-getLastModified :: FilePath -> IO ClockTime
-getLastModified "-" = getClockTime
-getLastModified fpath = getModificationTime fpath
+getLastModified :: FilePath -> IO UTCTime
+getLastModified "-" = getCurrentTime
+getLastModified fpath = getFileStatus fpath
+ >>= return . posixSecondsToUTCTime . fromRational . toRational . modificationTime
-getETag :: [CmdOpt] -> LazyByteString -> IO String
+getETag :: [CmdOpt] -> Lazy.ByteString -> IO String
getETag opts input
= let eTagOpts = filter (\ x -> case x of
OptETag _ -> True
_ -> False) opts
in
case eTagOpts of
- [] -> return mkETagFromInput
+ [] -> getDigestByName "SHA1" >>= return . mkETagFromInput . fromJust
(OptETag str):[] -> return str
_ -> error "too many --etag options."
where
- mkETagFromInput :: String
- mkETagFromInput = "SHA-1:" ++ (toHex $ hash $ L.unpack input)
+ mkETagFromInput :: Digest -> String
+ mkETagFromInput sha1 = "SHA-1:" ++ (toHex $ digestLBS sha1 input)
- toHex :: [Word8] -> String
+ toHex :: [Char] -> String
toHex [] = ""
- toHex (x:xs) = hexByte (fromIntegral x) ++ toHex xs
+ toHex (x:xs) = hexByte (fromEnum x) ++ toHex xs
hexByte :: Int -> String
hexByte n
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 LazyByteString
+openInput :: FilePath -> IO Lazy.ByteString
openInput "-" = L.getContents
openInput fpath = L.readFile fpath
Compression: disabled
MIME Type: image/png
ETag: d41d8cd98f00b204e9800998ecf8427e
- Last Modified: Wed, 03 Oct 2007 00:55:45 JST
+ Last Modified: 2007-11-05 13:53:42.231882 JST
-}
module Foo.Bar.Baz (baz) where
import Codec.Binary.Base64
- import Data.ByteString.Base (LazyByteString)
import qualified Data.ByteString.Lazy as L
+ import Data.Maybe
+ import Data.Time
import Network.HTTP.Lucu
- import System.Time
baz :: ResourceDef
baz = ResourceDef {
entityTag :: ETag
entityTag = strongETag "d41d8cd98f00b204e9800998ecf8427e"
- lastModified :: ClockTime
- lastModified = TOD 1191340545 0
+ lastModified :: UTCTime
+ lastModified = read "2007-11-05 04:47:56.008366 UTC"
contentType :: MIMEType
contentType = read "image/png"
- rawData :: LazyByteString
- rawData = L.pack (decode "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ...")
+ rawData :: L.ByteString
+ rawData = L.pack (fromJust (decode "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ..."))
------------------------------------------------------------------------------
壓縮される場合は次のやうに變はる:
}
-- rawData の代はりに gzippedData
- gzippedData :: LazyByteString
- gzippedData = L.pack (decode "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB...")
+ gzippedData :: L.ByteString
+ gzippedData = L.pack (fromJust (decode "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB..."))
------------------------------------------------------------------------------
-}