-import Codec.Binary.Base64
import Codec.Compression.GZip
import Control.Monad
import Data.Bits
+import qualified Data.ByteString as BS
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C8
import qualified Data.ByteString.Lazy as Lazy (ByteString)
-import qualified Data.ByteString.Lazy as L hiding (ByteString)
+import qualified Data.ByteString.Lazy as LS hiding (ByteString)
import Data.Char
import Data.Int
import Data.Maybe
let compParams = defaultCompressParams { compressLevel = bestCompression }
gzippedData = compressWith compParams input
- originalLen = L.length input
- gzippedLen = L.length gzippedData
+ originalLen = LS.length input
+ gzippedLen = LS.length gzippedData
useGZip = originalLen > gzippedLen
- rawB64 = encode $ L.unpack input
- gzippedB64 = encode $ L.unpack gzippedData
+ rawB64 = B64.encode $ BS.concat $ LS.toChunks input
+ gzippedB64 = B64.encode $ BS.concat $ LS.toChunks gzippedData
header <- mkHeader srcFile originalLen gzippedLen useGZip mimeType eTag lastMod
let hsModule = HsModule undefined (Module modName) (Just exports) imports decls
exports = [HsEVar (UnQual (HsIdent symName))]
- imports = [ HsImportDecl undefined (Module "Codec.Binary.Base64")
- False Nothing Nothing
+ imports = [ HsImportDecl undefined (Module "Data.ByteString.Base64")
+ True (Just (Module "B64")) Nothing
+ , HsImportDecl undefined (Module "Data.ByteString.Char8")
+ True (Just (Module "C8")) Nothing
, HsImportDecl undefined (Module "Data.ByteString.Lazy")
- True (Just (Module "L")) Nothing
- , HsImportDecl undefined (Module "Data.Maybe")
- False Nothing Nothing
+ True (Just (Module "LS")) Nothing
, HsImportDecl undefined (Module "Data.Time")
False Nothing Nothing
, HsImportDecl undefined (Module "Network.HTTP.Lucu")
declGZippedData
= [ HsTypeSig undefined [HsIdent "gzippedData"]
(HsQualType []
- (HsTyCon (Qual (Module "L") (HsIdent "ByteString"))))
+ (HsTyCon (Qual (Module "LS") (HsIdent "ByteString"))))
, HsFunBind [HsMatch undefined (HsIdent "gzippedData")
[] (HsUnGuardedRhs defGZippedData) []]
]
defGZippedData :: HsExp
defGZippedData
- = HsApp (HsVar (Qual (Module "L") (HsIdent "pack")))
- (HsParen
- (HsApp (HsVar (UnQual (HsIdent "fromJust")))
- (HsParen
- (HsApp (HsVar (UnQual (HsIdent "decode")))
- (HsLit (HsString gzippedB64))))))
+ = HsApp (HsVar (Qual (Module "LS") (HsIdent "fromChunks")))
+ (HsList [HsApp (HsVar (Qual (Module "B64") (HsIdent "decodeLenient")))
+ (HsParen
+ (HsApp (HsVar (Qual (Module "C8") (HsIdent "pack")))
+ (HsLit (HsString $ C8.unpack gzippedB64))))])
declRawData :: [HsDecl]
declRawData
= [ HsTypeSig undefined [HsIdent "rawData"]
(HsQualType []
- (HsTyCon (Qual (Module "L") (HsIdent "ByteString"))))
+ (HsTyCon (Qual (Module "LS") (HsIdent "ByteString"))))
, HsFunBind [HsMatch undefined (HsIdent "rawData")
[] (HsUnGuardedRhs defRawData) []]
]
defRawData :: HsExp
defRawData
- = HsApp (HsVar (Qual (Module "L") (HsIdent "pack")))
- (HsParen
- (HsApp (HsVar (UnQual (HsIdent "fromJust")))
- (HsParen
- (HsApp (HsVar (UnQual (HsIdent "decode")))
- (HsLit (HsString rawB64))))))
+ = HsApp (HsVar (Qual (Module "LS") (HsIdent "fromChunks")))
+ (HsList [HsApp (HsVar (Qual (Module "B64") (HsIdent "decodeLenient")))
+ (HsParen
+ (HsApp (HsVar (Qual (Module "C8") (HsIdent "pack")))
+ (HsLit (HsString $ C8.unpack rawB64))))])
hPutStrLn output header
hPutStrLn output (prettyPrint hsModule)
openInput :: FilePath -> IO Lazy.ByteString
-openInput "-" = L.getContents
-openInput fpath = L.readFile fpath
+openInput "-" = LS.getContents
+openInput fpath = LS.readFile fpath
openOutput :: [CmdOpt] -> IO Handle
Last Modified: 2007-11-05 13:53:42.231882 JST
-}
module Foo.Bar.Baz (baz) where
- import Codec.Binary.Base64
- import qualified Data.ByteString.Lazy as L
- import Data.Maybe
+ import qualified Data.ByteString.Base64 as B64
+ import qualified Data.ByteString.Char8 as C8
+ import qualified Data.ByteString.Lazy as LS
import Data.Time
import Network.HTTP.Lucu
contentType :: MIMEType
contentType = read "image/png"
- rawData :: L.ByteString
- rawData = L.pack (fromJust (decode "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ..."))
+ rawData :: LS.ByteString
+ rawData = LS.fromChunks [B64.decodeLenient (C8.pack "IyEvdXNyL2Jpbi9lbnYgcnVuZ2hjCgppbXBvcnQgRGlzdHJ...")]
------------------------------------------------------------------------------
壓縮される場合は次のやうに變はる:
}
-- rawData の代はりに gzippedData
- gzippedData :: L.ByteString
- gzippedData = L.pack (fromJust (decode "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB..."))
+ gzippedData :: LS.ByteString
+ gzippedData = LS.fromChunks [B64.decodeLenient (C8.pack "Otb/+DniOlRgAAAAYAAAAGAAAAB/6QOmToAEIGAAAAB...")]
------------------------------------------------------------------------------
-}
+{-# LANGUAGE
+ UnicodeSyntax
+ #-}
{-# OPTIONS_HADDOCK prune #-}
-- |Manipulation of WWW authorization.
, authCredentialP -- private
)
where
-
-import qualified Codec.Binary.Base64 as B64
-import Data.Maybe
-import Network.HTTP.Lucu.Parser
-import Network.HTTP.Lucu.Parser.Http
-import Network.HTTP.Lucu.Utils
+import qualified Data.ByteString.Base64 as B64
+import qualified Data.ByteString.Char8 as C8
+import Network.HTTP.Lucu.Parser
+import Network.HTTP.Lucu.Parser.Http
+import Network.HTTP.Lucu.Utils
+import Prelude.Unicode
-- |Authorization challenge to be sent to client with
-- \"WWW-Authenticate\" header. See
deriving (Eq)
-- |'Realm' is just a string which must not contain any non-ASCII letters.
-type Realm = String
+type Realm = String
-- |Authorization credential to be sent by client with
-- \"Authorization\" header. See
-- letters.
type Password = String
-
instance Show AuthChallenge where
show (BasicAuthChallenge realm)
- = "Basic realm=" ++ quoteStr realm
+ = "Basic realm=" ⧺ quoteStr realm
-
-authCredentialP :: Parser AuthCredential
-authCredentialP = allowEOF $!
- do _ <- string "Basic"
- _ <- many1 lws
- b64 <- many1
- $ satisfy (\ c -> (c >= 'a' && c <= 'z') ||
- (c >= 'A' && c <= 'Z') ||
- (c >= '0' && c <= '9') ||
- c == '+' ||
- c == '/' ||
- c == '=')
- let decoded = map (toEnum . fromEnum) (fromJust $ B64.decode b64)
- case break (== ':') decoded of
- (uid, ':' : password)
- -> return (BasicAuthCredential uid password)
- _ -> failP
+authCredentialP ∷ Parser AuthCredential
+authCredentialP
+ = allowEOF $!
+ do _ ← string "Basic"
+ _ ← many1 lws
+ b64 ← many1
+ $ satisfy (\c → (c ≥ 'a' ∧ c ≤ 'z') ∨
+ (c ≥ 'A' ∧ c ≤ 'Z') ∨
+ (c ≥ '0' ∧ c ≤ '9') ∨
+ c ≡ '+' ∨
+ c ≡ '/' ∨
+ c ≡ '=')
+ case break (≡ ':') (decode b64) of
+ (uid, ':' : password)
+ → return (BasicAuthCredential uid password)
+ _ → failP
+ where
+ decode ∷ String → String
+ decode = C8.unpack ∘ B64.decodeLenient ∘ C8.pack