diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/lib/NicovideoTranslator/Proxy.hs b/lib/NicovideoTranslator/Proxy.hs --- a/lib/NicovideoTranslator/Proxy.hs +++ b/lib/NicovideoTranslator/Proxy.hs @@ -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' diff --git a/nicovideo-translator.cabal b/nicovideo-translator.cabal --- a/nicovideo-translator.cabal +++ b/nicovideo-translator.cabal @@ -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