Network/HTTP/Lucu/ETag.hs

   1 {-# LANGUAGE
   2     DeriveDataTypeable
   3   , OverloadedStrings
   4   , RecordWildCards
   5   , TemplateHaskell
   6   , UnicodeSyntax
   7   #-}
   8 -- |An internal module for entity tags.
   9 module Network.HTTP.Lucu.ETag
  10     ( ETag(..)
  11     , parseETag
  12     , printETag
  13
  14     , strongETag
  15     , weakETag
  16     , eTag
  17     , eTagList
  18     )
  19     where
  20 import Control.Applicative
  21 import Control.Monad
  22 import Data.Ascii (Ascii, AsciiBuilder)
  23 import qualified Data.Ascii as A
  24 import Data.Attoparsec.Char8
  25 import Data.Data
  26 import Data.Monoid.Unicode
  27 import Language.Haskell.TH.Syntax
  28 import Network.HTTP.Lucu.Parser
  29 import Network.HTTP.Lucu.Parser.Http hiding (token)
  30 import Network.HTTP.Lucu.Utils
  31 import Prelude.Unicode
  32
  33 -- |An entity tag consists of a weakness flag and an opaque string.
  34 data ETag = ETag {
  35       -- |The weakness flag. Weak tags looks like W\/\"blahblah\" and
  36       -- strong tags are like \"blahblah\". See:
  37       -- <http://www.w3.org/Protocols/rfc2616/rfc2616-sec13.html#sec13.3.3>
  38       etagIsWeak ∷ !Bool
  39       -- |An opaque string. Only characters from 0x20 (sp) to 0x7e (~)
  40       -- are allowed.
  41     , etagToken  ∷ !Ascii
  42     } deriving (Eq, Show, Data, Typeable)
  43
  44 instance Lift ETag where
  45     lift (ETag {..})
  46         = [| ETag {
  47                etagIsWeak = $(lift etagIsWeak)
  48              , etagToken  = $(liftAscii etagToken)
  49              }
  50            |]
  51
  52 -- |Convert an 'ETag' to an 'AsciiBuilder'.
  53 printETag ∷ ETag → AsciiBuilder
  54 {-# INLINEABLE printETag #-}
  55 printETag et
  56     = ( if etagIsWeak et then
  57             A.toAsciiBuilder "W/"
  58         else
  59             (∅)
  60       )
  61       ⊕
  62       quoteStr (etagToken et)
  63
  64 -- |Parse 'Etag' from an 'Ascii'. This functions throws an exception
  65 -- for parse error.
  66 parseETag ∷ Ascii → ETag
  67 {-# INLINEABLE parseETag #-}
  68 parseETag str
  69     = case parseOnly (finishOff eTag) $ A.toByteString str of
  70         Right et → et
  71         Left err → error ("unparsable ETag: " ⧺ A.toString str ⧺ ": " ⧺ err)
  72
  73 -- |This is equivalent to @'ETag' 'False'@. If you want to generate an
  74 -- ETag from a file, try using
  75 -- 'Network.HTTP.Lucu.StaticFile.generateETagFromFile'.
  76 strongETag ∷ Ascii → ETag
  77 {-# INLINE strongETag #-}
  78 strongETag = ETag False
  79
  80 -- |This is equivalent to @'ETag' 'True'@.
  81 weakETag ∷ Ascii → ETag
  82 {-# INLINE weakETag #-}
  83 weakETag = ETag True
  84
  85 -- |'Parser' for an 'ETag'.
  86 eTag ∷ Parser ETag
  87 {-# INLINEABLE eTag #-}
  88 eTag = do isWeak ← option False (string "W/" *> return True)
  89           str    ← quotedStr
  90           return $ ETag isWeak str
  91
  92 -- |'Parser' for a list of 'ETag's.
  93 eTagList ∷ Parser [ETag]
  94 {-# INLINEABLE eTagList #-}
  95 eTagList = do xs ← listOf eTag
  96               when (null xs) $
  97                   fail "empty list of ETags"
  98               return xs