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 Network.HTTP.Lucu.ETag
26 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
27 import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap
28 import Network.HTTP.Lucu.MIMEType.Guess
29 import Network.HTTP.Lucu.MIMEType.TH
30 import Network.HTTP.Lucu.Utils
31 import Prelude.Unicode
39 , iRawData ∷ !L.ByteString
40 , iGZipped ∷ !L.ByteString
43 originalLen ∷ Input → Integer
44 originalLen (Input {..})
45 = fromIntegral $ L.length iRawData
47 gzippedLen ∷ Input → Integer
48 gzippedLen (Input {..})
49 = fromIntegral $ L.length iGZipped
51 useGZip ∷ Input → Bool
53 = originalLen i ≥ gzippedLen i
55 openInput ∷ FilePath → Maybe MIMEType → Maybe ETag → IO Input
56 openInput fpath ctype etag
57 = do lastMod ← lastModified fpath
58 input ← openInputFile fpath
62 , iType = fromMaybe octetStream
63 $ ctype <|> guessType fpath
64 , iETag = fromMaybe (mkETagFromInput input) etag
66 , iGZipped = compressWith compParams input
69 octetStream ∷ MIMEType
70 octetStream = [mimeType| application/octet-stream |]
72 compParams ∷ CompressParams
73 compParams = defaultCompressParams {
74 compressLevel = bestCompression
77 lastModified ∷ FilePath → IO UTCTime
78 lastModified "-" = getCurrentTime
79 lastModified fpath = getLastModified fpath
81 openInputFile ∷ FilePath → IO L.ByteString
82 openInputFile "-" = L.getContents
83 openInputFile fpath = L.readFile fpath
85 guessType ∷ FilePath → Maybe MIMEType
86 guessType = guessTypeByFileName defaultExtensionMap
88 mkETagFromInput ∷ L.ByteString → ETag
90 = strongETag $ A.unsafeFromString
91 $ "SHA-1:" ⧺ showDigest (sha1 input)