nicovideo-translator 0.2.0.0 → 0.3.0.0
raw patch · 3 files changed
+114/−30 lines, 3 filesdep ~http-clientdep ~lensdep ~wreq
Dependency ranges changed: http-client, lens, wreq, xml-conduit
Files
- README.md +35/−10
- lib/NicovideoTranslator/Proxy.hs +74/−15
- nicovideo-translator.cabal +5/−5
README.md view
@@ -2,11 +2,36 @@ ================================================= [![Build Status][0]][1]+[![Docker Automated Build][2]][3]+[![Hackage][4]][5] [0]: https://travis-ci.org/dahlia/nicovideo-translator.svg [1]: https://travis-ci.org/dahlia/nicovideo-translator+[2]: https://img.shields.io/docker/automated/dahlia/nicovideo-translator.svg+[3]: https://hub.docker.com/r/dahlia/nicovideo-translator/+[4]: https://img.shields.io/hackage/v/nicovideo-translator.svg+[5]: https://hackage.haskell.org/package/nicovideo-translator +Quick start using Docker+------------------------++The official Docker image is provided:++ $ docker pull dahlia/nicovideo-translator++You need to provide a required environment variable `GOOGLE_TRANSLATE_API_KEY`+to use Google Translate API, and may want to set an optional environment+variable `LANG` which means the target language. The exposed port number is+8080:++ $ docker run \+ -e GOOGLE_TRANSLATE_API_KEY=EiP3NSgLid81OjSwpOMkgV0rzD9SLHRqwqUwx2r \+ -e LANG=ko \+ -p 80:8080 \+ dahlia/nicovideo-translator++ Installation ------------ @@ -20,12 +45,12 @@ To make the translator to intercept comments from Nico Nico comment server, you have to alias Nico Nico comment server domain (`nmsg.nicovideo.jp`) to-your localhost (`127.0.0.1`). Open your [hosts file][2] using text editor+your localhost (`127.0.0.1`). Open your [hosts file][6] using text editor (you probably need administrator permission), and then add the following line: 127.0.0.1 nmsg.nicovideo.jp -[2]: http://en.wikipedia.org/wiki/Hosts_%28file%29+[6]: http://en.wikipedia.org/wiki/Hosts_%28file%29 Proxy server@@ -39,7 +64,7 @@ Running on http://0.0.0.0:80/ (Press ^C to quit) Upstream: nmsg.nicovideo.jp (202.248.110.173) -Note that it takes a [Google Translate API][3] key as its first argument.+Note that it takes a [Google Translate API][7] key as its first argument. You can terminate the server by pressing Ctrl-C. @@ -48,21 +73,21 @@ $ nicovideo-translator -l ko -[3]: https://cloud.google.com/translate/+[7]: https://cloud.google.com/translate/ Open source ----------- -It's written by [Hong Minhee][4], and distributed under [AGPLv3][].-You can find the source code from the [Git repository][5]:+It's written by [Hong Minhee][8], and distributed under [AGPLv3][].+You can find the source code from the [Git repository][9]: $ git clone git://github.com/dahlia/nicovideo-translator -Please report bugs to the [issue tracker][6] if you find.+Please report bugs to the [issue tracker][10] if you find. Pull requests welcome! -[4]: https://hongminhee.org/-[5]: https://github.com/dahlia/nicovideo-translator-[6]: https://github.com/dahlia/nicovideo-translator/issues+[8]: https://hongminhee.org/+[9]: https://github.com/dahlia/nicovideo-translator+[10]: https://github.com/dahlia/nicovideo-translator/issues [AGPLv3]: http://www.gnu.org/licenses/agpl-3.0.html
lib/NicovideoTranslator/Proxy.hs view
@@ -12,9 +12,11 @@ import Data.Maybe (catMaybes) import Control.Lens ((&), (.~), (^.))+import qualified Data.Aeson as A import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB import Data.CaseInsensitive (CI)+import qualified Data.HashMap.Lazy as LH import Data.LanguageCodes (ISO639_1) import Data.Set (Set, fromList, notMember) import Data.Text (Text, unpack)@@ -22,7 +24,7 @@ import Network.HTTP.Types.Method (Method) import Network.Wai (Application, rawPathInfo, rawQueryString, responseLBS, requestBody, requestHeaders, requestMethod)-import Network.Wreq (Options, checkStatus, defaults, deleteWith, getWith,+import Network.Wreq (Options, checkResponse, defaults, deleteWith, getWith, headers, postWith, putWith, responseBody, responseHeader, responseHeaders, responseStatus) import Network.Wreq.Lens (Response)@@ -63,6 +65,9 @@ , "content-encoding" ] +data ProxyAction = Pass | Translate ContentType deriving (Eq, Show)+data ContentType = Json | Xml deriving (Eq, Show)+ proxyApp :: ProxyConfiguration -> Text -> Application proxyApp config url req respond = do body <- requestBody req@@ -72,15 +77,18 @@ (mimetype, _) = B.breakByte 0x3b contentType -- drop after semicolon rStatus = (response ^. responseStatus) rHeaders = (response ^. responseHeaders)- toBeTranslated = method == "POST" && mimetype == "text/xml"- translated <- if toBeTranslated- then translateResponse (apiKey config)- (language config)- rBody- else return rBody+ proxyAction = case (method, mimetype) of+ ("POST", "text/xml") -> Translate Xml+ ("POST", "text/json") -> Translate Json+ ("POST", "application/json") -> Translate Json+ _ -> Pass+ f = case proxyAction of+ Pass -> return+ Translate t -> translateResponse (apiKey config) (language config) t+ translated <- f rBody let headers = [ (name, value) | (name, value) <- rHeaders- , name /= "content-length"+ , name /= "content-length" && name `notMember` hoppishHeaders ] -- Content-Length becomes invalid since the translated text doesn't -- have the same length to its source text@@ -88,10 +96,10 @@ where method = requestMethod req headerList = requestHeaders req- acceptAnyStatus _ _ _ = Nothing+ acceptAnyStatus _ _ = return () options = defaults & headers .~ [(k, v) | (k, v) <- headerList , k `notMember` hoppishHeaders]- & checkStatus .~ (Just acceptAnyStatus)+ & checkResponse .~ (Just acceptAnyStatus) request :: Method -> Options -> String -> B.ByteString -> IO (Response LB.ByteString)@@ -101,11 +109,26 @@ request "DELETE" = \options url _ -> deleteWith options url request _ = \_ _ _ -> ioError $ userError $ "unsupported method" -translateResponse :: ApiKey -> ISO639_1 -> LB.ByteString -> IO LB.ByteString-translateResponse apiKey' lang response = case parseLBS def response of- Left _ -> return response- Right doc -> do translatedDoc <- translateXml apiKey' lang doc- return $ renderLBS def translatedDoc+translateResponse :: ApiKey+ -> ISO639_1+ -> ContentType+ -> LB.ByteString+ -> IO LB.ByteString+translateResponse apiKey' lang Xml response =+ case parseLBS def response of+ Left _ -> return response+ Right doc -> do+ translatedDoc <- translateXml apiKey' lang doc+ return $ renderLBS def translatedDoc+translateResponse apiKey' lang Json response =+ case decoded of+ Nothing -> return response+ Just array -> do+ translated <- translateJson apiKey' lang array+ return $ A.encode translated+ where+ decoded :: Maybe [A.Object]+ decoded = A.decode response translateXml :: ApiKey -> ISO639_1 -> Document -> IO Document translateXml apiKey' lang doc = do@@ -138,3 +161,39 @@ | node' <- nodes ] where Element name attrs nodes = el++translateJson :: ApiKey -> ISO639_1 -> [A.Object] -> IO [A.Object]+translateJson apiKey' lang array = do+ translatedTexts <- translate apiKey' lang texts+ let index = LH.fromList $ zip texts translatedTexts+ return [ case t of+ Nothing -> o+ Just t' -> case LH.lookup t' index of+ Just translated -> updateChatContent o translated+ | (o, t) <- pairs+ ]+ where+ pairs :: [(A.Object, Maybe Text)]+ pairs = [ (o, chatContent o) | o <- array ]+ texts :: [Text]+ texts = [text | (_, Just text) <- pairs ]+ chatContent :: A.Object -> Maybe Text+ chatContent o = do+ chat' <- LH.lookup "chat" o+ chat <- case chat' of+ A.Object c -> return c+ _ -> Nothing+ content <- LH.lookup "content" chat+ case content of+ A.String t -> return t+ _ -> Nothing+ adjustH k h f = LH.adjust f k h+ updateChatContent :: A.Object -> Text -> A.Object+ updateChatContent o text =+ adjustH "chat" o $ \chat' ->+ case chat' of+ A.Object chat -> A.Object $ adjustH "content" chat $ \c ->+ case c of+ A.String _ -> A.String text+ _ -> c+ _ -> chat'
nicovideo-translator.cabal view
@@ -1,5 +1,5 @@ name: nicovideo-translator-version: 0.2.0.0+version: 0.3.0.0 synopsis: Nico Nico Douga (ニコニコ動画) Comment Translator description: Translate comments (written in Japanese) on Nico Nico Douga (ニコニコ動画) to your language.@@ -35,10 +35,10 @@ cmdargs >=0.10.12 && <0.11.0, containers, dns >=2.0.0 && <2.1.0,- http-client >=0.4.9 && <0.5.0,+ http-client >=0.5.6.1 && <0.6.0, http-types >=0.9.0 && <0.10.0, iso639,- lens >=4.14 && <4.15,+ lens >=4.15 && <4.16, lens-aeson >=1.0.0.5 && <1.1.0.0, setlocale >=1.0.0.2 && <1.1.0.0, text >=1.1.0.0 && <1.3.0.0,@@ -46,8 +46,8 @@ unordered-containers, wai >=3.2.1.1 && <3.3.0.0, warp >=3.2.8 && <3.3.0,- wreq >=0.4.1.0 && <0.5.0.0,- xml-conduit >=1.3.5 && <1.4.0+ wreq >=0.5.0.1 && <0.6.0.0,+ xml-conduit >=1.4.0.3 && <1.5.0 default-language: Haskell2010 ghc-options: -Wall -fwarn-incomplete-uni-patterns