{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
module Data.QRCodes (
createQRCode
, createSecureQRCode
, createSecureQRCode'
, byteStringToQR
, readQRString
, readQRStrSec
, readQRStrSec'
) where
import Codec.Picture.Png (writePng)
import Control.Applicative ((<$>))
import Crypto.PubKey.RSA
import Data.Binary
import qualified Data.ByteString.Char8 as BS
import Data.ByteString.Lazy (toStrict)
import qualified Data.ByteString.Lazy.Char8 as BSL
import Data.Char (toLower)
import Data.Maybe
import Data.QRCodes.Image
import Data.QRCodes.Signature
import Data.QRCodes.Utils
import Data.Word (Word8)
import System.Process
byteStringToQRSec :: BS.ByteString -> FilePath -> FilePath -> IO ()
byteStringToQRSec string keyfile filepath = flip byteStringToQR filepath =<< (fmap preserveUpper . flip mkSigFile keyfile) string
byteStringToQRSec' :: BS.ByteString -> (PublicKey, PrivateKey) -> FilePath -> IO ()
byteStringToQRSec' string key filepath = flip byteStringToQR filepath =<< (fmap preserveUpper . flip mkSig key) string
createSecureQRCode :: (Binary a) => a -> FilePath -> FilePath -> IO ()
createSecureQRCode object = byteStringToQRSec (toStrict $ encode object)
createSecureQRCode' :: (Binary a) => a -> (PublicKey, PrivateKey) -> FilePath -> IO ()
createSecureQRCode' object = byteStringToQRSec' (toStrict $ encode object)
createQRCode :: (Binary a) => a -> FilePath -> IO ()
createQRCode object filepath = let input = toStrict $ encode object in byteStringToQR input filepath
byteStringToQR :: BS.ByteString -> FilePath -> IO ()
byteStringToQR input filepath = bsToImg input >>= writePng filepath
snd' (_, y, _) = y
readQRString :: FilePath -> IO String
readQRString filepath = map toLower . init . (drop 8 . snd') <$> readCreateProcessWithExitCode (shell $ "zbarimg " ++ filepath) ""
readQRStrSec :: (Binary a) => FilePath -> FilePath -> IO a
readQRStrSec filepath keyfile = decode . BSL.pack <$> do
enc <- map toLower . init . drop 8 . snd' <$> readCreateProcessWithExitCode (shell $ "zbarimg " ++ filepath) ""
fmap (liftEither BS.unpack) . flip checkSigFile keyfile . resolveUpper $ BS.pack enc
readQRStrSec' :: (Binary a) => FilePath -> (PublicKey, PrivateKey) -> IO a
readQRStrSec' filepath key = decode . BSL.pack <$> do
enc <- map toLower . init . drop 8 . snd' <$> readCreateProcessWithExitCode (shell $ "zbarimg " ++ filepath) ""
fmap (liftEither BS.unpack) . flip checkSig key . resolveUpper $ BS.pack enc