]> gitweb @ CieloNegro.org - Lucu.git/blob - Network/HTTP/Lucu/Implant.hs
Use Data.Map.foldlWithKey' when possible
[Lucu.git] / Network / HTTP / Lucu / Implant.hs
1 {-# LANGUAGE
2     QuasiQuotes
3   , RecordWildCards
4   , UnicodeSyntax
5   #-}
6 -- |An internal module for generating Haskell modules eith an
7 -- arbitrary file implanted.
8 module Network.HTTP.Lucu.Implant
9     ( Input(..)
10
11     , originalLen
12     , gzippedLen
13     , useGZip
14
15     , openInput
16     )
17     where
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
23 import Data.Maybe
24 import Data.Time
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
32
33 data Input
34     = Input {
35         iPath    ∷ !FilePath
36       , iLastMod ∷ !UTCTime
37       , iType    ∷ !MIMEType
38       , iETag    ∷ !ETag
39       , iRawData ∷ !L.ByteString
40       , iGZipped ∷ !L.ByteString
41       }
42
43 originalLen ∷ Input → Integer
44 originalLen (Input {..})
45     = fromIntegral $ L.length iRawData
46
47 gzippedLen ∷ Input → Integer
48 gzippedLen (Input {..})
49     = fromIntegral $ L.length iGZipped
50
51 useGZip ∷ Input → Bool
52 useGZip i
53     = originalLen i ≥ gzippedLen i
54
55 openInput ∷ FilePath → Maybe MIMEType → Maybe ETag → IO Input
56 openInput fpath ctype etag
57     = do lastMod ← lastModified fpath
58          input   ← openInputFile fpath
59          return Input {
60                   iPath    = fpath
61                 , iLastMod = lastMod
62                 , iType    = fromMaybe octetStream
63                              $ ctype <|> guessType fpath
64                 , iETag    = fromMaybe (mkETagFromInput input) etag
65                 , iRawData = input
66                 , iGZipped = compressWith compParams input
67                 }
68     where
69       octetStream ∷ MIMEType
70       octetStream = [mimeType| application/octet-stream |]
71
72       compParams ∷ CompressParams
73       compParams = defaultCompressParams {
74                      compressLevel = bestCompression
75                    }
76
77 lastModified ∷ FilePath → IO UTCTime
78 lastModified "-"   = getCurrentTime
79 lastModified fpath = getLastModified fpath
80
81 openInputFile ∷ FilePath → IO L.ByteString
82 openInputFile "-"   = L.getContents
83 openInputFile fpath = L.readFile fpath
84
85 guessType ∷ FilePath → Maybe MIMEType
86 guessType = guessTypeByFileName defaultExtensionMap
87
88 mkETagFromInput ∷ L.ByteString → ETag
89 mkETagFromInput input
90     = strongETag $ A.unsafeFromString
91                  $ "SHA-1:" ⧺ showDigest (sha1 input)