]> gitweb @ CieloNegro.org - Lucu.git/commitdiff
Use base64-bytestring instead of dataenc
authorpho <pho@cielonegro.org>
Fri, 29 Jul 2011 21:06:33 +0000 (06:06 +0900)
committerpho <pho@cielonegro.org>
Fri, 29 Jul 2011 21:06:33 +0000 (06:06 +0900)
Ignore-this: b9744a1d6732b99150cc61c89c29ea83

darcs-hash:20110729210633-62b54-0d7612049231d2d18766a131413ed1de424aacb5.gz

21 files changed:
ImplantFile.hs
Lucu.cabal
Network/HTTP/Lucu/Abortion.hs
Network/HTTP/Lucu/Authorization.hs
Network/HTTP/Lucu/DefaultPage.hs
Network/HTTP/Lucu/HttpVersion.hs
Network/HTTP/Lucu/Interaction.hs
Network/HTTP/Lucu/MIMEType.hs
Network/HTTP/Lucu/MIMEType/Guess.hs
Network/HTTP/Lucu/MultipartForm.hs
Network/HTTP/Lucu/Parser.hs
Network/HTTP/Lucu/Parser/Http.hs
Network/HTTP/Lucu/Postprocess.hs
Network/HTTP/Lucu/RequestReader.hs
Network/HTTP/Lucu/Resource.hs
Network/HTTP/Lucu/Response.hs
Network/HTTP/Lucu/ResponseWriter.hs
Network/HTTP/Lucu/SocketLike.hs
Network/HTTP/Lucu/StaticFile.hs
Network/HTTP/Lucu/Utils.hs
examples/Makefile

index 1d7d43d8ce21f51666bb53b3b4652d94f37de063..fd57fadc456023ef5e78eee0b018098b12cada39 100644 (file)
@@ -1,9 +1,11 @@
-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
@@ -108,22 +110,22 @@ generateHaskellSource opts srcFile
 
          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")
@@ -295,37 +297,35 @@ generateHaskellSource opts srcFile
              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)
@@ -435,8 +435,8 @@ getETag opts input
 
 
 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
@@ -466,9 +466,9 @@ openOutput opts
          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
 
@@ -495,8 +495,8 @@ openOutput opts
   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...")]
   ------------------------------------------------------------------------------
 
   壓縮される場合は次のやうに變はる:
@@ -527,7 +527,7 @@ openOutput opts
         }
   
   -- 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...")]
   ------------------------------------------------------------------------------
  -}
index 6a37744d58a16ab1e6f64cfbbb9e94ad2f7d0d27..4452ee1c639e64ac541d6622b2c0f58e17771a13 100644 (file)
@@ -44,22 +44,23 @@ Flag build-lucu-implant-file
 
 Library
     Build-Depends:
-        HsOpenSSL   == 0.10.*,
-        base        == 4.3.*,
-        bytestring  == 0.9.*,
-        containers  == 0.4.*,
-        dataenc     == 0.14.*,
-        filepath    == 1.2.*,
-        directory   == 1.1.*,
-        haskell-src == 1.0.*,
-        hxt         == 9.1.*,
-        mtl         == 2.0.*,
-        network     == 2.3.*,
-        stm         == 2.2.*,
-        time        == 1.2.*,
-        time-http   == 0.1.*,
-        unix        == 2.4.*,
-        zlib        == 0.5.*
+        HsOpenSSL            == 0.10.*,
+        base                 == 4.3.*,
+        base-unicode-symbols == 0.2.*,
+        base64-bytestring    == 0.1.*,
+        bytestring           == 0.9.*,
+        containers           == 0.4.*,
+        filepath             == 1.2.*,
+        directory            == 1.1.*,
+        haskell-src          == 1.0.*,
+        hxt                  == 9.1.*,
+        mtl                  == 2.0.*,
+        network              == 2.3.*,
+        stm                  == 2.2.*,
+        time                 == 1.2.*,
+        time-http            == 0.1.*,
+        unix                 == 2.4.*,
+        zlib                 == 0.5.*
 
     Exposed-Modules:
         Network.HTTP.Lucu
@@ -96,15 +97,6 @@ Library
         Network.HTTP.Lucu.ResponseWriter
         Network.HTTP.Lucu.SocketLike
 
-    Extensions:
-        BangPatterns
-        DeriveDataTypeable
-        FlexibleContexts
-        FlexibleInstances
-        ScopedTypeVariables
-        TypeFamilies
-        UnboxedTuples
-
     ghc-options:
         -Wall
         -funbox-strict-fields
@@ -117,11 +109,6 @@ Executable lucu-implant-file
 
     Main-Is: ImplantFile.hs
 
-    Extensions:
-        BangPatterns
-        ScopedTypeVariables
-        UnboxedTuples
-
     ghc-options:
         -Wall
         -funbox-strict-fields
index db0c55262c62d9a568cf22347ace59c1f60f7e5b..26ea8b01e9bc4c6f5da8735e2af12046493dd324 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    DeriveDataTypeable
+  , UnicodeSyntax
+  #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 -- |Aborting the computation of 'Network.HTTP.Lucu.Resource.Resource'
@@ -18,7 +22,7 @@ import           Control.Concurrent.STM
 import           Control.Exception
 import           Control.Monad.Trans
 import qualified Data.ByteString.Char8 as C8
-import           Data.Dynamic
+import           Data.Typeable
 import           GHC.Conc (unsafeIOToSTM)
 import           Network.HTTP.Lucu.Config
 import           Network.HTTP.Lucu.DefaultPage
index 8e1be587e9c4f25c93f2e581db594e249972d96f..6b0e1c268323150607da4f5ea2be37a92ea9ff58 100644 (file)
@@ -1,3 +1,6 @@
+{-# LANGUAGE
+    UnicodeSyntax
+  #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 -- |Manipulation of WWW authorization.
@@ -11,12 +14,12 @@ module Network.HTTP.Lucu.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
@@ -26,7 +29,7 @@ data AuthChallenge
       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
@@ -43,25 +46,26 @@ type UserID   = String
 -- 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
index 5fd170564ef0dd5cb2ff1282bef839a1a71b5964..12aba154480cef33dc525acd04fe290423dcb48b 100644 (file)
@@ -1,3 +1,8 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnboxedTuples
+  , UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.DefaultPage
     ( getDefaultPage
     , writeDefaultPage
index ca25640a768c31e9f98dee79f29cee615dd72a0e..d48f6ec8c58f3d5009c3038ed500eb4e863e5003 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnicodeSyntax
+  #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 -- |Manipulation of HTTP version string.
index 4c93b41abf258999aa329121c98d90b43d666ffa..638d1b05bafc472f364cfb7626930f6f00a86423 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.Interaction
     ( Interaction(..)
     , InteractionState(..)
index b7ceb4043fdd656173f9d503cbe9974c2fdf8547..a3f3fc5453ff77ee9436b347da9ee94c46879296 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    UnboxedTuples
+  , UnicodeSyntax
+  #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 -- |Manipulation of MIME Types.
index 145adf8ad18eb94ce2371ee91336cd2ebd949cc5..39de37e07d68464b8029021f745e956fa236c036 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    UnboxedTuples
+  , UnicodeSyntax
+  #-}
 -- |MIME Type guessing by a file extension. This is a poor man's way
 -- of guessing MIME Types. It is simple and fast.
 --
index a2ee492bbb401c1268b74be37dbf5a7d90220046..c4631300e9efae3b3d14ac57917597ef685032fd 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    UnboxedTuples
+  , UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.MultipartForm
     ( FormData(..)
     , multipartFormP
index 34953f58c9dc5de637759c671f672b02815aa59e..7809f534790d2d770e147dc3b362a7df9b5c1203 100644 (file)
@@ -1,3 +1,9 @@
+{-# LANGUAGE
+    BangPatterns
+  , ScopedTypeVariables
+  , UnboxedTuples
+  , UnicodeSyntax
+  #-}
 -- |Yet another parser combinator. This is mostly a subset of
 -- "Text.ParserCombinators.Parsec" but there are some differences:
 --
index 78e48181c9f251023b4c11f88630e8b26b85e1d1..fe54bde4c5d9f08b10ce443dd029f6d5bd838aa2 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnicodeSyntax
+  #-}
 -- |This is an auxiliary parser utilities for parsing things related
 -- on HTTP protocol.
 --
index 0bd33ed1b00fc17b8f27a260cb57f88743e5972c..806ed1c1c9d07529ec3e84e65b367d69d1d881dd 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.Postprocess
     ( postprocess
     , completeUnconditionalHeaders
index cfc991a1ef5a70f415daf08ac40f6f4a10d17134..d3b8daad721a88b8b28a700c28565a278101d20a 100644 (file)
@@ -1,3 +1,8 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnboxedTuples
+  , UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.RequestReader
     ( requestReader
     )
@@ -27,7 +32,6 @@ import           Network.HTTP.Lucu.Resource.Tree
 import           Prelude hiding (catch)
 import           System.IO (stderr)
 
-
 requestReader :: HandleLike h => Config -> ResTree -> [FallbackHandler] -> h -> PortNumber -> SockAddr -> InteractionQueue -> IO ()
 requestReader !cnf !tree !fbs !h !port !addr !tQueue
     = do input <- hGetLBS h
index 15b211fba6d17872dc6201a55d8a69bdfd42c326..fa08fa5c3450c28b2131c7aa3320da814afa4e21 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    UnboxedTuples
+  , UnicodeSyntax
+  #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 -- |This is the Resource Monad; monadic actions to define the behavior
index 4954bc2654ffb273091dc1c2b5111308cd2a6c07..adf8505defd683f03a7292fc74a3f85ba20dc49c 100644 (file)
@@ -1,3 +1,8 @@
+{-# LANGUAGE
+    DeriveDataTypeable
+  , UnboxedTuples
+  , UnicodeSyntax
+  #-}
 {-# OPTIONS_HADDOCK prune #-}
 
 -- |Definition of things related on HTTP response.
@@ -17,7 +22,7 @@ module Network.HTTP.Lucu.Response
 
 import qualified Data.ByteString as Strict (ByteString)
 import qualified Data.ByteString.Char8 as C8 hiding (ByteString)
-import           Data.Dynamic
+import           Data.Typeable
 import           Network.HTTP.Lucu.Format
 import           Network.HTTP.Lucu.HandleLike
 import           Network.HTTP.Lucu.Headers
index 7892e2ab59c8f7a99bdb834c8adec8511330c188..9751a7699c7b175ba062ae750d4c5f710fffeac0 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.ResponseWriter
     ( responseWriter
     )
index b99811f3bba095f5fc6a586f7b5a00bb2750c23d..915f32376eb17a3ae6a57eef443648698bc4d63b 100644 (file)
@@ -1,3 +1,9 @@
+{-# LANGUAGE
+    FlexibleContexts
+  , FlexibleInstances
+  , TypeFamilies
+  , UnicodeSyntax
+  #-}
 module Network.HTTP.Lucu.SocketLike
     ( SocketLike(..)
     )
index 7ceb787d5a9355a040559cc867630efb090aa0ae..9175ce9289c816cdb4f8375195b9adf53efb2214 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnicodeSyntax
+  #-}
 -- | Handling static files on the filesystem.
 module Network.HTTP.Lucu.StaticFile
     ( staticFile
index f1c178d55a1b22983d1ec75907873186f4446686..c85c9a72b6a023241857ba1c613eb1e4d5a2485e 100644 (file)
@@ -1,3 +1,7 @@
+{-# LANGUAGE
+    BangPatterns
+  , UnicodeSyntax
+  #-}
 -- |Utility functions used internally in the Lucu httpd. These
 -- functions may be useful too for something else.
 module Network.HTTP.Lucu.Utils
index 3e2c6f02245cc2faacf0930bbaf86cb13df6e05b..abd928eb482b505dc60b8a194b7d65d2e29192ba 100644 (file)
@@ -16,7 +16,7 @@ run: build
        ./HelloWorld
 
 clean:
-       rm -f $(TARGETS) *.hi *.o
+       rm -f $(TARGETS) *.hi *.o MiseRafturai.hs SmallFile.hs
 
 MiseRafturai.hs: mise-rafturai.html
        lucu-implant-file -m MiseRafturai -o $@ $<