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)