]> gitweb @ CieloNegro.org - Lucu.git/blob - Network/HTTP/Lucu/Implant.hs
Code clean-up using convertible-text.
[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.ByteString.Lazy as L
21 import Data.Convertible.Base
22 import Data.Convertible.Instances.Ascii ()
23 import Data.Digest.Pure.SHA
24 import Data.Maybe
25 import Data.Time
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 Network.HTTP.Lucu.Utils
32 import Prelude.Unicode
33
34 data Input
35     = Input {
36         iPath    ∷ !FilePath
37       , iLastMod ∷ !UTCTime
38       , iType    ∷ !MIMEType
39       , iETag    ∷ !ETag
40       , iRawData ∷ !L.ByteString
41       , iGZipped ∷ !L.ByteString
42       }
43
44 originalLen ∷ Input → Integer
45 originalLen (Input {..})
46     = fromIntegral $ L.length iRawData
47
48 gzippedLen ∷ Input → Integer
49 gzippedLen (Input {..})
50     = fromIntegral $ L.length iGZipped
51
52 useGZip ∷ Input → Bool
53 useGZip i
54     = originalLen i ≥ gzippedLen i
55
56 openInput ∷ FilePath → Maybe MIMEType → Maybe ETag → IO Input
57 openInput fpath ctype etag
58     = do lastMod ← lastModified fpath
59          input   ← openInputFile fpath
60          return Input {
61                   iPath    = fpath
62                 , iLastMod = lastMod
63                 , iType    = fromMaybe octetStream
64                              $ ctype <|> guessType fpath
65                 , iETag    = fromMaybe (mkETagFromInput input) etag
66                 , iRawData = input
67                 , iGZipped = compressWith compParams input
68                 }
69     where
70       octetStream ∷ MIMEType
71       octetStream = [mimeType| application/octet-stream |]
72
73       compParams ∷ CompressParams
74       compParams = defaultCompressParams {
75                      compressLevel = bestCompression
76                    }
77
78 lastModified ∷ FilePath → IO UTCTime
79 lastModified "-"   = getCurrentTime
80 lastModified fpath = getLastModified fpath
81
82 openInputFile ∷ FilePath → IO L.ByteString
83 openInputFile "-"   = L.getContents
84 openInputFile fpath = L.readFile fpath
85
86 guessType ∷ FilePath → Maybe MIMEType
87 guessType = guessTypeByFileName defaultExtensionMap
88
89 mkETagFromInput ∷ L.ByteString → ETag
90 mkETagFromInput input
91     = strongETag $ convertUnsafe
92                  $ "SHA-1:" ⧺ showDigest (sha1 input)