diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2015 Alexander Thiemann + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,28 @@ +dataurl +===== + +[![Build Status](https://travis-ci.org/agrafix/dataurl.svg)](https://travis-ci.org/agrafix/dataurl) + + +## Intro + + +Handle data-urls + + +## Install + +* From Source (cabal): `git clone https://github.com/agrafix/dataurl.git && cd dataurl && cabal install` +* From Source (stack): `git clone https://github.com/agrafix/dataurl.git && cd dataurl && stack build` + + +## Misc + +### Supported GHC Versions + +* 7.10.2 + +### License + +Released under the MIT license. +(c) 2015 Alexander Thiemann diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/dataurl.cabal b/dataurl.cabal new file mode 100644 --- /dev/null +++ b/dataurl.cabal @@ -0,0 +1,47 @@ +name: dataurl +version: 0.1.0.0 +synopsis: Handle data-urls +description: Please see README.md +homepage: http://github.com/agrafix/dataurl#readme +license: MIT +license-file: LICENSE +author: Alexander Thiemann +maintainer: Alexander Thiemann +copyright: (c) 2015 Alexander Thiemann +category: Web +build-type: Simple +extra-source-files: + README.md +cabal-version: >=1.10 +tested-with: GHC==7.10.2 + +library + hs-source-dirs: src + exposed-modules: Web.DataUrl + build-depends: + base >= 4.7 && < 5, + attoparsec >=0.12, + bytestring >=0.10, + base64-bytestring >=1.0, + text >=1.2 + default-language: Haskell2010 + +test-suite dataurl-test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Test.hs + other-modules: Web.DataUrlTest + build-depends: + dataurl, + HTF >= 0.12, + base >= 4.7 && < 5, + attoparsec >=0.12, + bytestring >=0.10, + base64-bytestring >=1.0, + text >=1.2 + ghc-options: -threaded -rtsopts -with-rtsopts=-N + default-language: Haskell2010 + +source-repository head + type: git + location: https://github.com/agrafix/dataurl diff --git a/src/Web/DataUrl.hs b/src/Web/DataUrl.hs new file mode 100644 --- /dev/null +++ b/src/Web/DataUrl.hs @@ -0,0 +1,83 @@ +{-# LANGUAGE OverloadedStrings #-} +module Web.DataUrl + ( parseDataUrl + , DataUrlEnc(..), DataUrl(..) + ) +where + +import Control.Applicative +import Control.Monad +import Data.Attoparsec.Text +import Data.Char +import Data.Maybe +import qualified Data.ByteString as BS +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as BSC +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +-- | Source encoding of the data url string +data DataUrlEnc + = DataUrlEncB64 + | DataUrlEncUrl + deriving (Show, Eq) + +-- | A parsed data url +data DataUrl + = DataUrl + { du_contentType :: !T.Text + , du_charset :: !(Maybe T.Text) -- todo: fully strict + , du_sourceEncoding :: !DataUrlEnc + , du_data :: !BS.ByteString + } deriving (Show, Eq) + +-- | Parse a data url string +parseDataUrl :: T.Text -> Either String DataUrl +parseDataUrl = parseOnly dataUrlP + +dataUrlP :: Parser DataUrl +dataUrlP = + do _ <- string "data:" + mContentType <- + optional $ + do ct <- fieldContent + mCharSet <- + optional (string ";charset=" *> fieldContent) + return (ct, mCharSet) + isBase64 <- + isJust <$> + optional (string ";base64") + _ <- char ',' + rawData <- takeWhile1 (const True) + endOfInput + decodedData <- + if isBase64 + then case B64.decode (T.encodeUtf8 rawData) of + Left err -> fail err + Right val -> return val + else case urlDecode (T.unpack rawData) of + Nothing -> fail "Invalid url encoded data" + Just val -> return (BSC.pack val) + return + DataUrl + { du_contentType = maybe "text/plain" fst mContentType + , du_charset = join $ fmap snd mContentType + , du_sourceEncoding = + if isBase64 then DataUrlEncB64 else DataUrlEncUrl + , du_data = decodedData + } + where + fieldContent = + takeWhile1 (\c -> c /= ';' && c /= ',') + +-- hacky piece straight of some internet site :-( +urlDecode :: String -> Maybe String +urlDecode [] = Just [] +urlDecode ('%':xs) = + case xs of + (a:b:xss) -> + liftM ((chr . read $ "0x" ++ [a,b]) :) $ + urlDecode xss + _ -> Nothing +urlDecode ('+':xs) = liftM (' ' :) $ urlDecode xs +urlDecode (x:xs) = liftM (x :) $ urlDecode xs diff --git a/test/Test.hs b/test/Test.hs new file mode 100644 --- /dev/null +++ b/test/Test.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} +module Main where + +import Test.Framework +import {-@ HTF_TESTS @-} Web.DataUrlTest + +main :: IO () +main = htfMain htf_importedTests diff --git a/test/Web/DataUrlTest.hs b/test/Web/DataUrlTest.hs new file mode 100644 --- /dev/null +++ b/test/Web/DataUrlTest.hs @@ -0,0 +1,51 @@ +{-# OPTIONS_GHC -F -pgmF htfpp #-} +{-# LANGUAGE OverloadedStrings #-} +module Web.DataUrlTest where + +import Web.DataUrl + +import Test.Framework +import qualified Data.ByteString.Base64 as B64 +import qualified Data.Text as T +import qualified Data.Text.Encoding as T + +test_parseDataUrlUrlEnc :: IO () +test_parseDataUrlUrlEnc = + do x <- assertRight (parseDataUrl inputData) + assertEqual expected x + where + expected = + DataUrl + { du_contentType = "text/plain" + , du_charset = Nothing + , du_sourceEncoding = DataUrlEncUrl + , du_data = "A brief note" + } + inputData = "data:,A%20brief%20note" + +test_parseDataUrlB64 :: IO () +test_parseDataUrlB64 = + do x <- assertRight (parseDataUrl inputData) + assertEqual expected x + where + expected = + DataUrl + { du_contentType = "image/png" + , du_charset = Nothing + , du_sourceEncoding = DataUrlEncB64 + , du_data = B64.decodeLenient (T.encodeUtf8 inputB64) + } + inputB64 = + T.concat + [ "iVBORw0KGgoAAAANSUhEUgAAAAoAAAAKCAYAAACNMs+9AAAABGdBTUEAALGP" + , "C/xhBQAAAAlwSFlzAAALEwAACxMBAJqcGAAAAAd0SU1FB9YGARc5KB0XV+IA" + , "AAAddEVYdENvbW1lbnQAQ3JlYXRlZCB3aXRoIFRoZSBHSU1Q72QlbgAAAF1J" + , "REFUGNO9zL0NglAAxPEfdLTs4BZM4DIO4C7OwQg2JoQ9LE1exdlYvBBeZ7jq" + , "ch9//q1uH4TLzw4d6+ErXMMcXuHWxId3KOETnnXXV6MJpcq2MLaI97CER3N0" + , "vr4MkhoXe0rZigAAAABJRU5ErkJggg==" + ] + inputData = + T.concat + [ "data:image/png;base64," + , inputB64 + ]