6 -- |An internal module for generating Haskell modules eith an
7 -- arbitrary file implanted.
8 module Network.HTTP.Lucu.Implant
18 import Codec.Compression.GZip
19 import Control.Applicative
20 import qualified Data.Ascii as A
21 import qualified Data.ByteString.Lazy as L
22 import Data.Digest.Pure.SHA
25 import Data.Time.Clock.POSIX
26 import Network.HTTP.Lucu.ETag
27 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
28 import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap
29 import Network.HTTP.Lucu.MIMEType.Guess
30 import Network.HTTP.Lucu.MIMEType.TH
31 import Prelude.Unicode
32 import System.Posix.Files
40 , iRawData ∷ !L.ByteString
41 , iGZipped ∷ !L.ByteString
44 originalLen ∷ Input → Integer
45 originalLen (Input {..})
46 = fromIntegral $ L.length iRawData
48 gzippedLen ∷ Input → Integer
49 gzippedLen (Input {..})
50 = fromIntegral $ L.length iGZipped
52 useGZip ∷ Input → Bool
54 = originalLen i ≥ gzippedLen i
56 openInput ∷ FilePath → Maybe MIMEType → Maybe ETag → IO Input
57 openInput fpath ctype etag
58 = do lastMod ← lastModified fpath
59 input ← openInputFile fpath
63 , iType = fromMaybe octetStream
64 $ ctype <|> guessType fpath
65 , iETag = fromMaybe (mkETagFromInput input) etag
67 , iGZipped = compressWith compParams input
70 octetStream ∷ MIMEType
71 octetStream = [mimeType| application/octet-stream |]
73 compParams ∷ CompressParams
74 compParams = defaultCompressParams {
75 compressLevel = bestCompression
78 lastModified ∷ FilePath → IO UTCTime
79 lastModified "-" = getCurrentTime
80 lastModified fpath = ( posixSecondsToUTCTime
88 openInputFile ∷ FilePath → IO L.ByteString
89 openInputFile "-" = L.getContents
90 openInputFile fpath = L.readFile fpath
92 guessType ∷ FilePath → Maybe MIMEType
93 guessType = guessTypeByFileName defaultExtensionMap
95 mkETagFromInput ∷ L.ByteString → ETag
97 = strongETag $ A.unsafeFromString
98 $ "SHA-1:" ⧺ showDigest (sha1 input)