packages feed

qr-imager 0.1.2.1 → 0.2.0.0

raw patch · 6 files changed

+44/−26 lines, 6 files

Files

README.md view
@@ -31,3 +31,6 @@ ``` qrpipe read "nametag.png" ```++## Library+The library can be used via the exported functions `createQRCode`, `byteStringToQR` and `readQRString`, plus their signed counterparts.
qr-imager.cabal view
@@ -1,5 +1,5 @@ name:                qr-imager-version:             0.1.2.1+version:             0.2.0.0 synopsis:            Library to generate QR codes from bytestrings and objects description:         Please see README.md homepage:            https://github.com/vmchale/QRImager#readme
src/Data/QRCodes.hs view
@@ -2,11 +2,13 @@ {-# LANGUAGE FlexibleContexts #-}  -- | Module providing several functions for creating QR codes and their signed counterparts-module Data.QRCodes ( createSecureQRCode+module Data.QRCodes (-- * Functions on objects+                      createSecureQRCode                     , createQRCode+                    -- * Functions for `ByteStrings`                     , byteStringToQR                     , byteStringToQRSec-                    -- * functions to read in QR codes with the Zbar library+                    -- * functions to read QR codes                     , readQRString                     , readQRStrSec                     ) where@@ -25,15 +27,20 @@ import Data.QRCodes.Signature import Data.QRCodes.Image --- | Creates a signed QR code from a strict bytestring-byteStringToQRSec :: BS.ByteString -> FilePath -> IO ()-byteStringToQRSec string filepath = (flip byteStringToQR filepath) =<< (((fmap preserveUpper) . mkSig) string)+-- | Creates a signed QR code from a strict bytestring and path to keyfile/path where the keyfile should be generated.+-- Note that QR codes may only contain a small number of characters, so encrypting can sometimes make an object too big to encode.+--+-- > byteStringToQRSec (BS.pack "hello") ".key.hk" "qrcode.png"+byteStringToQRSec :: BS.ByteString -> FilePath -> FilePath -> IO ()+byteStringToQRSec string keyfile filepath = (flip byteStringToQR filepath) =<< (((fmap preserveUpper) . (flip mkSig keyfile)) string)  -- | Creates a signed QR code from an object that is part of the ToJSON class-createSecureQRCode :: (ToJSON a) => a -> FilePath -> IO ()+createSecureQRCode :: (ToJSON a) => a -> FilePath -> FilePath -> IO () createSecureQRCode object = byteStringToQRSec (toStrict $ encode object)  -- | Creates a QR code from an object that is part of the ToJSON class+--+-- > createQRCode userRecord "user-231.png" createQRCode :: (ToJSON a) => a -> FilePath -> IO () createQRCode object filepath = let input = toStrict $ encode object in byteStringToQR input filepath @@ -45,11 +52,15 @@     writePng filepath (encodePng qrMatrix)  -- | given a filepath, read the QR code as a string in all lowercase+--+-- > readQRString "picture.jpg" readQRString :: FilePath -> IO String readQRString filepath = (map toLower) . init . (drop 8 . view _2) <$> readCreateProcessWithExitCode (shell $ "zbarimg " ++ filepath) "" --- | given a filepath pointing to a QR code, get the contents & verify signature-readQRStrSec :: FilePath -> IO String-readQRStrSec filepath = do+-- | given a filepath pointing to a QR code, get the contents & verify signature with the keyfile+--+-- > readQRStrSec "output.png" ".key.hk"+readQRStrSec :: FilePath -> FilePath -> IO String+readQRStrSec filepath keyfile = do     enc <- (map toLower) . init . (drop 8) . (view _2) <$> readCreateProcessWithExitCode (shell $ "zbarimg " ++ filepath) ""-    (fmap $ liftEither show) . checkSig . resolveUpper $ (BS.pack) enc+    (fmap $ liftEither show) . (flip checkSig keyfile) . resolveUpper $ (BS.pack) enc
src/Data/QRCodes/Exe.hs view
@@ -1,5 +1,5 @@ -- | Parse options applicatively and read or write secure or non-secure QR codes.-module Data.QRCodes.Exe (exec) where+module Data.QRCodes.Exe where  import Options.Applicative import qualified Data.ByteString as B@@ -28,20 +28,20 @@ act :: Prog -> IO () act (Prog Output True True filepath) = do     pipeIn <- B.getContents-    byteStringToQRSec pipeIn filepath-    readQRStrSec filepath >>= print+    byteStringToQRSec pipeIn ".key.hk" filepath+    readQRStrSec filepath ".key.hk" >>= print act (Prog Output False True filepath) = do     pipeIn <- B.getContents     byteStringToQR pipeIn filepath     readQRString filepath >>= print act (Prog Output True False filepath) = do     pipeIn <- B.getContents-    byteStringToQRSec pipeIn filepath+    byteStringToQRSec pipeIn ".key.hk" filepath act (Prog Output False False filepath) = do     pipeIn <- B.getContents     byteStringToQR pipeIn filepath act (Prog Input True _ filepath) = do-    readQRStrSec filepath >>= print+    readQRStrSec filepath ".key.hk" >>= print act (Prog Input False _ filepath) = do     readQRString filepath >>= print
src/Data/QRCodes/Signature.hs view
@@ -1,3 +1,4 @@+-- | Functions associated with signing the JSON records module Data.QRCodes.Signature where  import Jose.Jws@@ -9,24 +10,24 @@ import Jose.Jwa (JwsAlg (RS256)) import Data.QRCodes.Utils --- | Verify a signed token-checkSig :: BS.ByteString -> IO (Either JwtError BS.ByteString)-checkSig tok = do-    key <- read <$> readFile ".key.hk" :: IO (Cr.PublicKey, Cr.PrivateKey)+-- | Verify a signed token with a key from a given filepath+checkSig :: BS.ByteString -> FilePath -> IO (Either JwtError BS.ByteString)+checkSig tok filepath = do+    key <- read <$> readFile filepath :: IO (Cr.PublicKey, Cr.PrivateKey)     let jws = rsaDecode (view _1 key) tok     return $ fmap (view _2) jws --- | Sign a token (note that we must pass in a processed token since there is no uppercase/lowercase here)-mkSig :: BS.ByteString -> IO BS.ByteString-mkSig string = do-    switch <- doesFileExist ".key.hk"+-- | Sign a token (note that we must pass in a processed token since there is no uppercase/lowercase here) with a key from a given filepath+mkSig :: BS.ByteString -> FilePath -> IO BS.ByteString+mkSig string filepath = do+    switch <- doesFileExist filepath     if not switch then do         putStrLn "generating key..."         key <- Cr.generate 256 0x10001-        writeFile ".key.hk" (show key)+        writeFile filepath (show key)     else         return ()-    key' <- read <$> readFile ".key.hk" :: IO (Cr.PublicKey, Cr.PrivateKey)+    key' <- read <$> readFile filepath :: IO (Cr.PublicKey, Cr.PrivateKey)     signedToken <- rsaEncode RS256 (view _2 key') string     let signed = fmap unJwt signedToken     liftEither id (return <$> signed)
src/Data/QRCodes/Utils.hs view
@@ -1,3 +1,4 @@+-- | Miscellaneous helper functions that don't fit anywhere else module Data.QRCodes.Utils where  import qualified Data.ByteString.Char8 as BS@@ -14,9 +15,11 @@ resolveUpper = lift rU     where rU = foldr (.) id (map (\s -> replace (s : "!") ((pure . toUpper) s)) ['a'..'z']) +-- | given a function on strings, make it act on byteStrings lift :: (String -> String) -> (BS.ByteString -> BS.ByteString) lift f = BS.pack . f . BS.unpack +-- | helper function to life Either values to IO in our case liftEither :: (Show b, Monad m) => (t -> m a) -> Either b t -> m a liftEither = either (error . show)