hs-pkpass 0.4 → 0.6

raw patch · 3 files changed

+95/−59 lines, 3 filesdep +binarydep +conduit-extradep +resourcetdep −filesystem-conduitdep ~aesondep ~conduitdep ~old-localenew-uploaderPVP ok

version bump matches the API change (PVP)

Dependencies added: binary, conduit-extra, resourcet, scientific, shakespeare

Dependencies removed: filesystem-conduit

Dependency ranges changed: aeson, conduit, old-locale, random, shakespeare-text, shelly, text, time, uuid

API changes (from Hackage documentation)

Files

• Passbook.hs +39/−16
• Passbook/Types.hs +33/−25
• hs-pkpass.cabal +23/−18

@@ -1,5 +1,6 @@ {-# LANGUAGE ExtendedDefaultRules #-} {-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE PackageImports       #-} {-# OPTIONS_GHC -fno-warn-type-defaults #-}  @@ -58,18 +59,23 @@ import           Control.Monad             (liftM) import           Control.Monad.IO.Class    (liftIO) import           Data.Aeson+import           Data.Binary               (Word32)+import           Data.Bits                 (shiftR, (.&.)) import qualified Data.ByteString.Lazy      as LB+import           Data.Char                 (intToDigit) import           Data.Conduit import           Data.Conduit.Binary       hiding (sinkFile)-import           Data.Conduit.Filesystem+import           Data.Conduit.Combinators  (sinkFile)+import           Control.Monad.Trans.Resource import qualified Data.Text                 as ST import           Data.Text.Lazy            (Text) import qualified Data.Text.Lazy            as LT import           Data.UUID import           Filesystem.Path           (filename)-import           Filesystem.Path.CurrentOS (encodeString)+import           Filesystem.Path.CurrentOS (encodeString, decodeString) import           Passbook.Types import           Prelude                   hiding (FilePath)+import           Shelly (FilePath) import           Shelly import           System.Directory          (doesFileExist) import           System.Random@@ -139,31 +145,32 @@     let tmp = passOut </> passId         lazyId = LT.fromStrict passId     cp_r passIn tmp-    liftIO $ renderPass (tmp </> "pass.json") pass { serialNumber = passId }+    liftIO $ renderPass (tmp </> ((Shelly.fromText "pass.json") :: FilePath)) pass { serialNumber = passId }     signcmd lazyId tmp passOut     rm_rf tmp-    return (passOut </> LT.append lazyId ".pkpass")+    return (passOut </> LT.unpack (LT.append lazyId ".pkpass"))  -- |Helper function to generate a hash genHash :: FilePath -> Sh (Text, Text) genHash file = do     rawhash <- run "openssl" ["sha1", toTextIgnore file]-    let hash = LT.drop 1 $ LT.dropWhile (/= ' ') rawhash-    return (toTextIgnore $ filename file, LT.filter (/= '\n') hash)+    let hash = LT.drop 1 $ LT.dropWhile (/= ' ') (LT.fromStrict rawhash)+    return (LT.fromStrict (toTextIgnore $ encodeString $ filename (decodeString file)), LT.filter (/= '\n') hash)  -- |Render JSON and put it in a file saveJSON :: ToJSON a => a -> FilePath -> IO ()-saveJSON json path = LB.writeFile (LT.unpack $ toTextIgnore path) $ encode json+saveJSON json path = LB.writeFile (ST.unpack $ toTextIgnore path) $ encode json  -- |Helper function to sign the manifest sslSign :: FilePath -- ^ Certificate         -> FilePath -- ^ Key         -> FilePath -- ^ Temporary directory containing manifest.json-        -> Sh Text+        -> Sh ST.Text sslSign cert key  tmp =     run "openssl" [ "smime", "-binary"                   , "-sign"                   , "-signer", toTextIgnore cert+                  , "-certfile", "wwdr.pem"                   , "-inkey" , toTextIgnore key                   , "-in", "manifest.json"                   , "-out", "signature"@@ -230,20 +237,36 @@     let tmp = passOut </> passId         passFile = LT.append (LT.fromStrict $ passId) ".pkpass"     cp_r passIn tmp-    liftIO $ renderPass (tmp </> "pass.json") (pass { serialNumber = passId })+    liftIO $ renderPass (tmp </> Shelly.fromText ("pass.json" :: ST.Text)) (pass { serialNumber = passId })     cd tmp     manifest <- liftM Manifest $ pwd >>= ls >>= mapM genHash-    liftIO $ saveJSON manifest (tmp </> "manifest.json")+    liftIO $ saveJSON manifest (tmp </> ("manifest.json" :: FilePath))     sslSign cert key tmp-    files <- liftM (map (toTextIgnore . filename)) $ ls =<< pwd-    run "zip" ((toTextIgnore $ passOut </> passFile) : files)+    files <- liftM (map (\f -> toTextIgnore (encodeString $ filename (decodeString f)))) $ ls =<< pwd+    run "zip" ((toTextIgnore $ passOut </> (LT.unpack passFile)) : files)     rm_rf tmp-    return (passOut </> passFile)+    return (passOut </> (LT.unpack passFile))  -- |Generates a random UUID for a Pass using "Data.UUID" and "System.Random" genPassId :: IO ST.Text-genPassId = liftM (ST.pack . toString) randomIO+genPassId = liftM (ST.pack . showPassId) randomIO +-- |Shows a UUID without the hyphens+showPassId :: UUID -> String+showPassId uuid = let (w0, w1, w2, w3) = toWords uuid+                  in hexw w0 $ hexw' w1 $ hexw' w2 $ hexw w3 ""+    where hexw :: Word32 -> String -> String+          hexw  w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16+                    : hexn w 12 : hexn w  8 : hexn w  4 : hexn w  0 : s++          hexw' :: Word32 -> String -> String+          hexw' w s = hexn w 28 : hexn w 24 : hexn w 20 : hexn w 16+                    : hexn w 12 : hexn w  8 : hexn w  4 : hexn w  0 : s++          hexn :: Word32 -> Int -> Char+          hexn w r = intToDigit $ fromIntegral ((w `shiftR` r) .&. 0xf)++ -- |Render and store a pass.json at the desired location. renderPass :: FilePath -> Pass -> IO () renderPass path pass =@@ -257,7 +280,7 @@         -> Sh () signcmd uuid assetFolder passOut =     run_ "signpass" [ "-p", toTextIgnore assetFolder -- The input folder-                    , "-o", toTextIgnore $ passOut </> LT.append uuid ".pkpass" ] -- Name of the output file+                    , "-o", toTextIgnore $ passOut </> LT.unpack (LT.append uuid ".pkpass") ] -- Name of the output file  -- |Tries to parse the pass.json file contained in a .pkpass into a valid --  'Pass'. If Passbook accepts the .pkpass file, this function should never@@ -265,7 +288,7 @@ loadPass :: FilePath -- ^ Location of the .pkpass file          -> IO (Maybe Pass) loadPass path = do-    archive <- liftM toArchive $ LB.readFile $ encodeString path+    archive <- liftM toArchive $ LB.readFile $ path     case findEntryByPath "pass.json" archive of         Nothing   -> return Nothing         Just pass -> return $ decode $ fromEntry pass

@@ -5,6 +5,7 @@ {-# LANGUAGE QuasiQuotes               #-} {-# LANGUAGE RecordWildCards           #-} {-# LANGUAGE TemplateHaskell           #-}+{-# OPTIONS_GHC -fdefer-type-errors    #-}  {- |This module provides types and functions for type-safe generation of PassBook's @pass.json@ files. @@ -49,10 +50,12 @@ import qualified Data.HashMap.Strict    as HM import           Data.Text              (Text, pack, unpack) import qualified Data.Text.Lazy         as LT+import           Data.String            (fromString) import           Data.Time import           Data.Typeable-import           System.Locale+import           System.Locale          hiding (iso8601DateFormat, timeFmt, defaultTimeLocale) import           Text.Shakespeare.Text+import           Data.Scientific (floatingOrInteger)  -- | Auxiliary type to ensure that field values are rendered correctly data PassValue = PassInt Integer@@ -102,11 +105,11 @@     deriving (Eq, Ord, Show, Read, Typeable)  -- |Pass field date/time display style-data DateTimeStyle = None -- ^ Corresponds to @NSDateFormatterNoStyle@-                   | Short -- ^ Corresponds to @NSDateFormatterShortStyle@-                   | Medium -- ^ Corresponds to @NSDateFormatterMediumStyle@-                   | Long -- ^ Corresponds to @NSDateFormatterLongStyle@-                   | Full -- ^ Corresponds to @NSDateFormatterFullStyle@+data DateTimeStyle = None -- ^ Corresponds to @PKDateStyleNone@+                   | Short -- ^ Corresponds to @PKDateStyleShort@+                   | Medium -- ^ Corresponds to @PKDateStyleMedium@+                   | Long -- ^ Corresponds to @PKDateStyleLong@+                   | Full -- ^ Corresponds to @PKDateStyleFull@     deriving (Eq, Ord, Show, Read, Typeable)  -- |Pass field number display style@@ -169,7 +172,9 @@ -- |A complete pass data Pass = Pass {     -- Required keys-      description                :: Text -- ^ Brief description of the pass (required)+      expirationDate :: Maybe Text+    , voided :: Maybe Bool+    , description                :: Text -- ^ Brief description of the pass (required)     , organizationName           :: Text -- ^ Display name of the organization that signed the pass (required)     , passTypeIdentifier         :: Text -- ^ Pass type identifier, as issued by Apple (required)     , serialNumber               :: Text -- ^ Unique serial number for the pass (required)@@ -201,7 +206,7 @@  instance ToJSON Manifest where     toJSON (Manifest files) =-      let pairs = map (\(f, h) -> LT.toStrict f .= h) files+      let pairs = map (\(f, h) -> (fromString $ unpack $ LT.toStrict f) .= h) files       in object pairs  -- * JSON instances@@ -210,9 +215,9 @@ --  because Passbook can't deal with null values in JSON. (-:) :: ToJSON a => Text -> Maybe a -> [Pair] -> [Pair] (-:) _ Nothing = id-(-:) key (Just value) = ((key .= value) :)+(-:) key (Just value) = (((fromString $ unpack $ key) .= value) :) -$(deriveToJSON id ''PassContent)+$(deriveToJSON defaultOptions ''PassContent)  instance ToJSON Location where     toJSON Location{..} =@@ -248,6 +253,8 @@     toJSON Pass{..} =       let pairs =   ("relevantDate" -: relevantDate)                   $ ("barcode" -: barcode)+                  $ ("expirationDate" -: expirationDate)+                  $ ("voided" -: voided)                   $ ("backgroundColor" -: backgroundColor)                   $ ("foregroundColor" -: foregroundColor)                   $ ("labelColor" -: labelColor)@@ -263,7 +270,7 @@                     , "teamIdentifier" .= teamIdentifier                     , "associatedStoreIdentifiers" .= associatedStoreIdentifiers                     , "locations" .= locations-                    , passTypeName passContent .= passContent]+                    , (fromString $ unpack $ passTypeName passContent) .= passContent]       in object pairs  -- |Internal helper function to handle Boarding Passes correctly.@@ -313,11 +320,11 @@     toJSON Natural    = toJSON ("PKTextAlignment" :: Text)  instance ToJSON DateTimeStyle where-    toJSON None    = toJSON ("NSDateFormatterNoStyle" :: Text)-    toJSON Short   = toJSON ("NSDateFormatterShortStyle" :: Text)-    toJSON Medium  = toJSON ("NSDateFormatterMediumStyle" :: Text)-    toJSON Long    = toJSON ("NSDateFormatterLongStyle" :: Text)-    toJSON Full    = toJSON ("NSDateFormatterFullStyle" :: Text)+    toJSON None    = toJSON ("PKDateStyleNone" :: Text)+    toJSON Short   = toJSON ("PKDateStyleShort" :: Text)+    toJSON Medium  = toJSON ("PKDateStyleMedium" :: Text)+    toJSON Long    = toJSON ("PKDateStyleLong" :: Text)+    toJSON Full    = toJSON ("PKDateStyleFull" :: Text)  instance ToJSON NumberStyle where     toJSON Decimal    = toJSON ("PKNumberStyleDecimal" :: Text)@@ -350,7 +357,7 @@  -- |Helper function that parses a 'UTCTime' out of a Text parseJsonDate :: Text -> Maybe UTCTime-parseJsonDate = parseTime defaultTimeLocale timeFormat . unpack+parseJsonDate = parseTimeM True defaultTimeLocale timeFormat . unpack  -- * Implementing FromJSON @@ -365,11 +372,11 @@  instance FromJSON DateTimeStyle where     parseJSON (String t) = case t of-        "NSDateFormatterNoStyle" -> pure None-        "NSDateFormatterShortStyle" -> pure Short-        "NSDateFormatterMediumStyle" -> pure Medium-        "NSDateFormatterLongStyle" -> pure Long-        "NSDateFormatterFullStyle" -> pure Full+        "PKDateStyleNone" -> pure None+        "PKDateStyleShort" -> pure Short+        "PKDateStyleMedium" -> pure Medium+        "PKDateStyleLong" -> pure Long+        "PKDateStyleFull" -> pure Full         _ -> fail "Could not parse date formatting style"     parseJSON _ = mzero @@ -417,8 +424,9 @@     parseJSON _ = mzero  instance FromJSON PassValue where-    parseJSON (Number (I i)) = pure $ PassInt i-    parseJSON (Number (D d)) = pure $ PassDouble d+    parseJSON (Number num) = case floatingOrInteger num of+        Left d -> pure $ PassDouble d+        Right i -> pure $ PassInt i     parseJSON (String t) = case parseJsonDate t of         Just d  -> pure $ PassDate d         Nothing -> pure $ PassText t@@ -445,7 +453,7 @@         Nothing  -> fail "Could not parse relevant date"     parseJSON _ = mzero -$(deriveFromJSON id ''PassContent)+$(deriveFromJSON defaultOptions ''PassContent)  -- |Tries to parse a web service parseWebService :: Maybe Text -> Maybe Text -> Maybe WebService

@@ -1,42 +1,47 @@--- Initial hs-pkpass.cabal generated by cabal init.  For further +-- Initial hs-pkpass.cabal generated by cabal init.  For further -- documentation, see http://haskell.org/cabal/users-guide/  name:                hs-pkpass-version:             0.4+version:             0.6 synopsis:            A library for Passbook pass creation & signing description:         A Haskell library for type-safe creation of Passbook passes and signing through Apple's signpass tool. homepage:            https://github.com/tazjin/hs-pkpass license:             BSD3 license-file:        LICENSE author:              Vincent Ambo-maintainer:          geva@humac.com--- copyright:           +maintainer:          marc@digitallyinduced.com+-- copyright: category:            Apple build-type:          Simple-cabal-version:       >=1.8+cabal-version:       >=1.10  source-repository    head     type: git-    location: https://github.com/tazjin/hs-pkpass.git+    location: https://github.com/digitallyinduced/hs-pkpass.git  library+  default-language: Haskell2010   exposed-modules:     Passbook, Passbook.Types-  -- other-modules:       +  -- other-modules:   build-depends:       base >= 4 && < 5,                        directory >= 1 && < 2,-                       aeson ==0.6.*,-                       conduit ==0.5.*,-                       filesystem-conduit ==0.5.*,-                       text ==0.11.*,-                       uuid ==1.2.*,-                       shelly ==0.14.*,-                       random == 1.0.*,-                       time ==1.4.*,-                       old-locale ==1.0.*,-                       shakespeare-text ==1.0.*,+                       aeson >= 0.6,+                       conduit >= 0.5,+                       conduit-extra,+                       resourcet,+                       shakespeare,+                       text >= 0.11,+                       uuid >= 1.2,+                       shelly >= 0.14,+                       random >= 1.0,+                       time >= 1,+                       old-locale >= 1.0,+                       shakespeare-text >= 1.0,                        attoparsec >= 0.8.6.1,                        unordered-containers >= 0.2,                        zip-archive >= 0.1.1.8,                        system-filepath < 0.5,                        bytestring,-                       transformers >= 0.3+                       transformers >= 0.3,+                       binary >= 0.5,+                       scientific