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)