import Data.Ascii (Ascii)
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
+import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
import Data.Default
import Data.Text (Text)
-import qualified Data.Text as T
import Network
import Network.BSD
import Network.HTTP.Lucu.MIMEType.Guess
instance Default Config where
def = Config {
cnfServerSoftware = "Lucu/1.0"
- , cnfServerHost = CI.mk ∘ T.pack $ unsafePerformIO getHostName
+ , cnfServerHost = CI.mk ∘ cs $ unsafePerformIO getHostName
, cnfServerPort = "http"
, cnfServerV4Addr = Just "0.0.0.0"
, cnfServerV6Addr = Just "::"
getCIHeader ∷ CIAscii → a → Maybe CIAscii
{-# INLINE getCIHeader #-}
- getCIHeader = ((A.toCIAscii <$>) ∘) ∘ getHeader
+ getCIHeader = ((cs <$>) ∘) ∘ getHeader
deleteHeader ∷ CIAscii → a → a
{-# INLINE deleteHeader #-}
return $ fromFoldable xs
where
header ∷ Parser (CIAscii, Ascii)
- header = do name ← A.toCIAscii <$> token
+ header = do name ← cs <$> token
void $ char ':'
skipMany lws
values ← content `sepBy` try lws
joinValues ∷ [Ascii] → Ascii
{-# INLINE joinValues #-}
- joinValues = A.fromAsciiBuilder
+ joinValues = cs
∘ mconcat
- ∘ intersperse (A.toAsciiBuilder "\x20")
- ∘ (A.toAsciiBuilder <$>)
+ ∘ intersperse (cs ("\x20" ∷ Ascii) ∷ AsciiBuilder)
+ ∘ (cs <$>)
return $ AsciiParam name sect payload
nameP ∷ Parser (CIAscii, Integer, Bool)
-nameP = do name ← (A.toCIAscii ∘ A.unsafeFromByteString) <$>
+nameP = do name ← (cs ∘ A.unsafeFromByteString) <$>
takeWhile1 (\c → isToken c ∧ c ≢ '*')
sect ← option 0 $ try (char '*' *> decimal )
isEncoded ← option False $ try (char '*' *> pure True)
return (charset, payload)
where
metadata ∷ Parser CIAscii
- metadata = (A.toCIAscii ∘ A.unsafeFromByteString) <$>
+ metadata = (cs ∘ A.unsafeFromByteString) <$>
takeWhile (\c → c ≢ '\'' ∧ isToken c)
encodedPayload ∷ Parser BS.ByteString
→ fail (concat [ "Duplicate section "
, show $ section x
, " for parameter '"
- , A.toString $ A.fromCIAscii $ epName x
+ , cs $ epName x
, "'"
])
→ fail (concat [ "Missing section "
, show $ section p
, " for parameter '"
- , A.toString $ A.fromCIAscii $ epName p
+ , cs $ epName p
, "'"
])
Just (ContinuedEncodedParam {..}, _)
→ fail "decodeSeq: internal error: CEP at section 0"
Just (AsciiParam {..}, xs)
- → let t = A.toText apPayload
- in
- decodeSeq' Nothing xs $ singleton t
+ → decodeSeq' Nothing xs $ singleton $ cs apPayload
decodeSeq' ∷ Monad m
⇒ Maybe Decoder
→ fail (concat [ "Section "
, show epSection
, " for parameter '"
- , A.toString $ A.fromCIAscii epName
+ , cs epName
, "' is encoded but its first section is not"
])
Just (AsciiParam {..}, xs)
- → let t = A.toText apPayload
- in
- decodeSeq' decoder xs $ chunks ⊳ t
+ → decodeSeq' decoder xs $ chunks ⊳ cs apPayload
type Decoder = BS.ByteString → Either UnicodeException Text
getDecoder charset
| charset ≡ "UTF-8" = return decodeUtf8'
| charset ≡ "US-ASCII" = return decodeUtf8'
- | otherwise = fail $ "No decoders found for charset: "
- ⧺ A.toString (A.fromCIAscii charset)
+ | otherwise = fail $ "No decoders found for charset: " ⊕ cs charset
where
import Control.Applicative
import Data.Ascii (Ascii, AsciiBuilder, CIAscii)
-import qualified Data.Ascii as A
-import Data.Attoparsec.Char8 as P
+import Data.Attoparsec.Char8
import Data.Convertible.Base
import Data.Convertible.Instances.Ascii ()
import Data.Convertible.Utils
-- |'Parser' for an 'MIMEType'.
mimeType ∷ Parser MIMEType
{-# INLINEABLE mimeType #-}
-mimeType = do media ← A.toCIAscii <$> token
+mimeType = do media ← cs <$> token
_ ← char '/'
- sub ← A.toCIAscii <$> token
+ sub ← cs <$> token
params ← mimeParams
return $ MIMEType media sub params
import Data.Attoparsec.Char8
import qualified Data.Attoparsec.Lazy as LP
import qualified Data.ByteString.Lazy.Char8 as Lazy
+import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
import qualified Data.Map as M
import Data.Map (Map)
import Data.Typeable
import Data.Monoid
import Data.Monoid.Unicode
import Data.Text (Text)
-import qualified Data.Text as T
import Data.Text.Encoding
import Language.Haskell.TH.Syntax
import Language.Haskell.TH.Quote
guessTypeByFileName (ExtMap m) fpath
= case takeExtension fpath of
[] → Nothing
- (_:ext) → M.lookup (T.pack ext) m
+ (_:ext) → M.lookup (cs ext) m
import Control.Monad.Error (MonadError, throwError)
import Control.Monad.Unicode
import Data.Ascii (Ascii, CIAscii, AsciiBuilder)
-import qualified Data.Ascii as A
+import Data.Attempt
import Data.Attoparsec
import qualified Data.Attoparsec.Lazy as LP
import qualified Data.ByteString as BS
import Data.Monoid.Unicode
import Data.Sequence (Seq)
import Data.Text (Text)
-import qualified Data.Text as T
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.MIMEParams
import Network.HTTP.Lucu.MIMEType (MIMEType)
prologue boundary
= ( (string "--" <?> "prefix")
*>
- (string (A.toByteString boundary) <?> "boundary")
+ (string (cs boundary) <?> "boundary")
*>
pure ()
)
Nothing
→ throwError "Content-Disposition is missing"
Just str
- → case parseOnly (finishOff contentDisposition) $ A.toByteString str of
+ → case parseOnly (finishOff contentDisposition) $ cs str of
Right d → return d
Left err → throwError $ "malformed Content-Disposition: "
- ⧺ A.toString str
- ⧺ ": "
- ⧺ err
+ â\8a\95 cs str
+ â\8a\95 ": "
+ â\8a\95 err
contentDisposition ∷ Parser ContDispo
contentDisposition
- = (ContDispo <$> (A.toCIAscii <$> token) ⊛ mimeParams)
+ = (ContDispo <$> (cs <$> token) ⊛ mimeParams)
<?>
"contentDisposition"
Nothing
→ return Nothing
Just str
- → case parseOnly (finishOff MT.mimeType) $ A.toByteString str of
+ → case parseOnly (finishOff MT.mimeType) $ cs str of
Right d → return $ Just d
Left err → throwError $ "malformed Content-Type: "
- ⧺ A.toString str
- ⧺ ": "
- ⧺ err
+ â\8a\95 cs str
+ â\8a\95 ": "
+ â\8a\95 err
getBody ∷ MonadError String m
⇒ Ascii
→ LS.ByteString
→ m (LS.ByteString, LS.ByteString)
{-# INLINEABLE getBody #-}
-getBody (("\r\n--" ⊕) ∘ A.toByteString → boundary) src
+getBody (("\r\n--" ⊕) ∘ cs → boundary) src
= case breakOn boundary src of
(before, after)
| LS.null after
return (name, fd)
| otherwise
= throwError $ "disposition type is not \"form-data\": "
- ⧺ A.toString (A.fromCIAscii $ dType ptContDispo)
+ â\8a\95 cs (dType ptContDispo)
partName ∷ MonadError String m ⇒ Part → m Ascii
{-# INLINEABLE partName #-}
partName (Part {..})
= case lookup "name" $ dParams ptContDispo of
Just name
- → case A.fromText name of
- Just a → return a
- Nothing → throwError $ "Non-ascii part name: "
- ⧺ T.unpack name
+ → case ca name of
+ Success a → return a
+ Failure e → throwError $ show e
Nothing
→ throwError $ "form-data without name: "
⊕ convertSuccessVia ((⊥) ∷ Ascii) ptContDispo
import Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
import Data.Maybe
import Data.Text (Text)
-import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Network.HTTP.Lucu.Headers
import Network.HTTP.Lucu.HttpVersion
uri' = uri {
uriAuthority = Just URIAuth {
uriUserInfo = ""
- , uriRegName = T.unpack $ CI.original host
+ , uriRegName = cs $ CI.original host
, uriPort = cs port
}
}
import qualified Data.Attoparsec.Lazy as LP
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Lazy as Lazy
+import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
import Data.List
import Data.Maybe
import Data.Monoid.Unicode
import qualified Data.Sequence as S
-import qualified Data.Text as T
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.Config
import Network.HTTP.Lucu.Chunk
= let abo = mkAbortion BadRequest [("Connection", "close")]
$ Just
$ "chunkWasMalformed: "
- ⊕ T.pack msg
+ ⊕ cs msg
⊕ ": "
- ⊕ T.pack (intercalate ", " eCtx)
+ ⊕ cs (intercalate ", " eCtx)
⊕ ": "
- ⊕ T.pack e
+ ⊕ cs e
in
throwTo tid abo
import Data.Proxy
import Data.Tagged
import Data.Text (Text)
-import qualified Data.Text as T
import Data.Time
import Data.Time.Format.HTTP
import Network.HTTP.Lucu.Abortion
else
abort $ mkAbortion' RequestEntityTooLarge
$ "Request body must be smaller than "
- ⊕ T.pack (show limit)
+ ⊕ cs (show limit)
⊕ " bytes."
go !n !b = do c ← getChunk $ min n BB.defaultBufferSize
if Strict.null c then
$ "Malformed boundary: " ⊕ boundary
case parseMultipartFormData b src of
Right xs → return $ map (first cs) xs
- Left err → abort $ mkAbortion' BadRequest $ T.pack err
+ Left err → abort $ mkAbortion' BadRequest $ cs err
-- |@'redirect' code uri@ declares the response status as @code@ and
-- \"Location\" header field as @uri@. The @code@ must satisfy
import qualified Data.ByteString as BS
import Data.Collections
import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
import Data.List (intersperse, nub)
import Data.Maybe
import Data.Monoid
import Data.Monoid.Unicode
-import qualified Data.Text as T
import Network.HTTP.Lucu.Abortion
import Network.HTTP.Lucu.Abortion.Internal
import Network.HTTP.Lucu.Config
toAbortion e
= case fromException e of
Just abortion → abortion
- Nothing → mkAbortion' InternalServerError $ T.pack $ show e
+ Nothing → mkAbortion' InternalServerError $ cs $ show e
processException ∷ SomeException → IO ()
processException exc
import Control.Monad.Trans
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy.Char8 as LBS
+import Data.Convertible.Base
+import Data.Convertible.Instances.Text ()
import Data.Monoid.Unicode
import Data.String
import qualified Data.Text as T
handleStaticFile sendContent path
where
dec8 ∷ ByteString → String
- dec8 = T.unpack ∘ T.decodeUtf8
+ dec8 = cs ∘ T.decodeUtf8
securityCheck ∷ (Eq s, Show s, IsString s, Monad m) ⇒ [s] → m ()
securityCheck pathElems
import Data.Collections
import Data.Collections.BaseInstances ()
import Data.Convertible.Base
+import Data.Convertible.Instances.Ascii ()
+import Data.Convertible.Instances.Text ()
import Data.Convertible.Instances.Time ()
import Data.Maybe
import Data.Monoid.Unicode
import Data.Text (Text)
-import qualified Data.Text as T
import Data.Time
import Network.URI
import Prelude hiding (last, mapM, null, reverse)
-- >>> quoteStr "ab\"c"
-- "\"ab\\\"c\""
quoteStr ∷ Ascii → AsciiBuilder
-quoteStr str = A.toAsciiBuilder "\"" ⊕
- go (A.toByteString str) (∅) ⊕
- A.toAsciiBuilder "\""
+quoteStr str = cs ("\"" ∷ Ascii) ⊕
+ go (cs str) (∅) ⊕
+ cs ("\"" ∷ Ascii)
where
go ∷ ByteString → AsciiBuilder → AsciiBuilder
go bs ab
→ ab ⊕ b2ab x
| otherwise
→ go (BS.tail y)
- (ab ⊕ b2ab x ⊕ A.toAsciiBuilder "\\\"")
+ (ab ⊕ b2ab x ⊕ cs ("\\\"" ∷ Ascii))
b2ab ∷ ByteString → AsciiBuilder
- b2ab = A.toAsciiBuilder ∘ A.unsafeFromByteString
+ b2ab = cs ∘ A.unsafeFromByteString
-- |>>> parseWWWFormURLEncoded "aaa=bbb&ccc=ddd"
-- [("aaa", "bbb"), ("ccc", "ddd")]
-- THINKME: We could gain some performance by using attoparsec
-- here.
| src ≡ "" = []
- | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (A.toString src)
+ | otherwise = do pairStr ← splitBy (\ c → c ≡ ';' ∨ c ≡ '&') (cs src)
let (key, value) = break (≡ '=') pairStr
return ( unescape key
, unescape $ case value of
-- "example.com"
uriHost ∷ URI → Host
{-# INLINE uriHost #-}
-uriHost = CI.mk ∘ T.pack ∘ uriRegName ∘ fromJust ∘ uriAuthority
+uriHost = CI.mk ∘ cs ∘ uriRegName ∘ fromJust ∘ uriAuthority
-- |>>> uriPathSegments "http://example.com/foo/bar"
-- ["foo", "bar"]
projects / Lucu.git / commitdiff