Network/HTTP/Lucu/Implant/Input.hs

   1 {-# LANGUAGE
   2     QuasiQuotes
   3   , RecordWildCards
   4   , UnicodeSyntax
   5   #-}
   6 module Network.HTTP.Lucu.Implant.Input
   7     ( Input(..)
   8
   9     , originalLen
  10     , gzippedLen
  11     , useGZip
  12
  13     , openInput
  14     )
  15     where
  16 import Codec.Compression.GZip
  17 import Control.Applicative
  18 import qualified Data.Ascii as A
  19 import qualified Data.ByteString.Lazy as L
  20 import Data.Digest.Pure.SHA
  21 import Data.Maybe
  22 import Data.Time
  23 import Data.Time.Clock.POSIX
  24 import Network.HTTP.Lucu.ETag
  25 import Network.HTTP.Lucu.MIMEType hiding (mimeType)
  26 import Network.HTTP.Lucu.MIMEType.DefaultExtensionMap
  27 import Network.HTTP.Lucu.MIMEType.Guess
  28 import Network.HTTP.Lucu.MIMEType.TH
  29 import Prelude.Unicode
  30 import System.Posix.Files
  31
  32 data Input
  33     = Input {
  34         iPath    ∷ !FilePath
  35       , iLastMod ∷ !UTCTime
  36       , iType    ∷ !MIMEType
  37       , iETag    ∷ !ETag
  38       , iRawData ∷ !L.ByteString
  39       , iGZipped ∷ !L.ByteString
  40       }
  41
  42 originalLen ∷ Input → Integer
  43 originalLen (Input {..})
  44     = fromIntegral $ L.length iRawData
  45
  46 gzippedLen ∷ Input → Integer
  47 gzippedLen (Input {..})
  48     = fromIntegral $ L.length iGZipped
  49
  50 useGZip ∷ Input → Bool
  51 useGZip i
  52     = originalLen i ≥ gzippedLen i
  53
  54 openInput ∷ FilePath → Maybe MIMEType → Maybe ETag → IO Input
  55 openInput fpath ctype etag
  56     = do lastMod ← lastModified fpath
  57          input   ← openInputFile fpath
  58          return Input {
  59                   iPath    = fpath
  60                 , iLastMod = lastMod
  61                 , iType    = fromMaybe octetStream
  62                              $ ctype <|> guessType fpath
  63                 , iETag    = fromMaybe (mkETagFromInput input) etag
  64                 , iRawData = input
  65                 , iGZipped = compressWith compParams input
  66                 }
  67     where
  68       octetStream ∷ MIMEType
  69       octetStream = [mimeType| application/octet-stream |]
  70
  71       compParams ∷ CompressParams
  72       compParams = defaultCompressParams {
  73                      compressLevel = bestCompression
  74                    }
  75
  76 lastModified ∷ FilePath → IO UTCTime
  77 lastModified "-"   = getCurrentTime
  78 lastModified fpath = ( posixSecondsToUTCTime
  79                      ∘ fromRational
  80                      ∘ toRational
  81                      ∘ modificationTime
  82                      )
  83                      <$>
  84                      getFileStatus fpath
  85
  86 openInputFile ∷ FilePath → IO L.ByteString
  87 openInputFile "-"   = L.getContents
  88 openInputFile fpath = L.readFile fpath
  89
  90 guessType ∷ FilePath → Maybe MIMEType
  91 guessType = guessTypeByFileName defaultExtensionMap
  92
  93 mkETagFromInput ∷ L.ByteString → ETag
  94 mkETagFromInput input
  95     = strongETag $ A.unsafeFromString
  96                  $ "SHA-1:" ⧺ showDigest (sha1 input)