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 Data.Time.Clock.POSIX
  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 Prelude.Unicode
  32 import System.Posix.Files
  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 = ( posixSecondsToUTCTime
  81                      ∘ fromRational
  82                      ∘ toRational
  83                      ∘ modificationTime
  84                      )
  85                      <$>
  86                      getFileStatus fpath
  87
  88 openInputFile ∷ FilePath → IO L.ByteString
  89 openInputFile "-"   = L.getContents
  90 openInputFile fpath = L.readFile fpath
  91
  92 guessType ∷ FilePath → Maybe MIMEType
  93 guessType = guessTypeByFileName defaultExtensionMap
  94
  95 mkETagFromInput ∷ L.ByteString → ETag
  96 mkETagFromInput input
  97     = strongETag $ A.unsafeFromString
  98                  $ "SHA-1:" ⧺ showDigest (sha1 input)