hs-pkpass 0.1.2.2 → 0.2
raw patch · 3 files changed
+288/−70 lines, 3 filesdep +attoparsecdep +bytestringdep +system-filepathdep ~directory
Dependencies added: attoparsec, bytestring, system-filepath, unordered-containers, zip-archive
Dependency ranges changed: directory
Files
- Passbook.hs +29/−9
- Passbook/Types.hs +249/−50
- hs-pkpass.cabal +10/−11
Passbook.hs view
@@ -9,6 +9,9 @@ I intend to move the signing process to a Haskell native OpenSSL binding later on, but due to time constraints didn't get around to it yet. + If you want to use this module with an existing .pkpass file, you can import its+ @pass.json@ file using the function 'loadPass'.+ The function 'signpass' creates a random UUID during the signing process, uses this UUID as the passes' serial number and returns it along with the path to the signed pass. @@ -50,20 +53,26 @@ , signpassWithId , signpassWithModifier , genPassId- , updateBarcode ) where+ , updateBarcode+ , loadPass ) where +import Codec.Archive.Zip+import Control.Monad (liftM) import Data.Aeson+import Data.ByteString.Lazy as LB import Data.Conduit-import Data.Conduit.Binary hiding (sinkFile)+import Data.Conduit.Binary hiding (sinkFile) import Data.Conduit.Filesystem-import qualified Data.Text as ST-import Data.Text.Lazy as LT+import qualified Data.Text as ST+import Data.Text.Lazy as LT import Data.UUID+import Filesystem.Path.CurrentOS (encodeString) import Passbook.Types-import Prelude hiding (FilePath)+import Prelude hiding (FilePath) import Shelly-import System.Directory (doesFileExist)+import System.Directory (doesFileExist) import System.Random+ default (LT.Text) -- |Takes the filepaths to the folder containing the path assets@@ -112,11 +121,11 @@ liftIO $ renderPass (tmp </> "pass.json") pass { serialNumber = passId } signcmd lazyId tmp passOut rm_rf tmp- return (passOut </> (LT.append lazyId ".pkpass"))+ return (passOut </> LT.append lazyId ".pkpass") -- |Generates a random UUID for a Pass using "Data.UUID" and "System.Random" genPassId :: IO ST.Text-genPassId = randomIO >>= return . ST.pack . toString+genPassId = liftM (ST.pack . toString) randomIO -- |Render and store a pass.json at the desired location. renderPass :: FilePath -> Pass -> IO ()@@ -131,4 +140,15 @@ -> 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.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+-- return @Nothing@.+loadPass :: FilePath -- ^ Location of the .pkpass file+ -> IO (Maybe Pass)+loadPass path = do+ archive <- liftM toArchive $ LB.readFile $ encodeString path+ case findEntryByPath "pass.json" archive of+ Nothing -> return Nothing+ Just pass -> return $ decode $ fromEntry pass
Passbook/Types.hs view
@@ -1,13 +1,12 @@+{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_HADDOCK -ignore-exports #-}-- {- |This module provides types and functions for type-safe generation of PassBook's @pass.json@ files. This is a complete implementation of the Passbook Package Format Reference, available at@@ -16,28 +15,55 @@ It ensures that passes are created correctly wherever possible. Currently, NSBundle localization is not supported. -}-module Passbook.Types where+module Passbook.Types(+ -- * Passbook field types+ PassValue(..)+ , RelevantDate+ , Location(..)+ , RGBColor+ , BarcodeFormat(..)+ , Barcode(..)+ , Alignment(..)+ , DateTimeStyle(..)+ , NumberStyle(..)+ , TransitType(..)+ , WebService(..)+ -- * Passbook types+ , PassField(..)+ , PassType(..)+ , PassContent(..)+ , Pass(..)+ -- * Auxiliary functions+ , rgb+ , mkBarcode+ , mkSimpleField+ ) where +import Control.Applicative (pure, (<$>), (<*>))+import Control.Monad (mzero) import Data.Aeson import Data.Aeson.TH-import Data.Aeson.Types-import Data.Text (Text, pack)+import Data.Aeson.Types hiding (Parser)+import Data.Attoparsec.Number+import Data.Attoparsec.Text+import qualified Data.HashMap.Strict as HM+import Data.Text (Text, pack, unpack) import Data.Time+import Data.Typeable import System.Locale import Text.Shakespeare.Text --- | Auxiliary class to ensure that field values are rendered correctly-class ToJSON a => ToPassField a--instance ToPassField Int-instance ToPassField Double-instance ToPassField PassDate-instance ToPassField Text --where+-- | Auxiliary type to ensure that field values are rendered correctly+data PassValue = PassInt Integer+ | PassDouble Double+ | PassDate UTCTime+ | PassText Text+ deriving (Eq, Ord, Show, Typeable) -- * Passbook data types -type Encoding = Text-type Message = Text+-- |Newtype wrapper around 'UTCTime' for use in the @relevantDate@ field of a pass.+newtype RelevantDate = RelevantDate UTCTime deriving (Eq, Ord, Show, Typeable) -- |A location field data Location = Location {@@ -45,17 +71,19 @@ , longitude :: Double -- ^ Longitude, in degrees, of the location (required) , altitude :: Maybe Double -- ^ Altitude, in meters, of the location (optional) , relevantText :: Maybe Text -- ^ Text displayed on the lock screen when the pass is relevant (optional)-}+} deriving (Eq, Ord, Show, Typeable) -- |A simple RGB color value. In combination with the 'rgb' function this can be written just like in -- CSS, e.g. @rgb(43, 53, 65)@. The 'rgb' function also ensures that the provided values are valid. data RGBColor = RGB Int Int Int+ deriving (Eq, Ord, Show, Typeable) -- |Barcode is constructed by a Barcode format, an encoding -- type and the Barcode message. data BarcodeFormat = QRCode | PDF417 | Aztec+ deriving (Eq, Ord, Show, Typeable) -- |A pass barcode. In most cases the helper function 'mkBarcode' should be sufficient. data Barcode = Barcode {@@ -63,13 +91,14 @@ , format :: BarcodeFormat -- ^ Barcode format (required) , message :: Text -- ^ Message / payload to be displayed as a barcode (required) , messageEncoding :: Text -- ^ Barcode encoding. Default in the mkBarcode functions is iso-8859-1 (required)-}+} deriving (Eq, Ord, Show, Typeable) -- |Pass field alignment data Alignment = LeftAlign | Center | RightAlign | Natural+ deriving (Eq, Ord, Typeable) -- |Pass field date/time display style data DateTimeStyle = None -- ^ Corresponds to @NSDateFormatterNoStyle@@@ -77,24 +106,24 @@ | Medium -- ^ Corresponds to @NSDateFormatterMediumStyle@ | Long -- ^ Corresponds to @NSDateFormatterLongStyle@ | Full -- ^ Corresponds to @NSDateFormatterFullStyle@+ deriving (Eq, Ord, Typeable) -- |Pass field number display style data NumberStyle = Decimal | Percent | Scientific | SpellOut+ deriving (Eq, Ord, Typeable) --- |A single pass field. The 'value' of a 'PassField' can be anything that is an instance of 'ToPassField'.--- Dates and numbers are always correctly formatted. If you add another type to 'ToPassField' please make sure--- that it's corresponding 'ToJSON' instance generates Passbook-compatible JSON.+-- |A single pass field. The type 'PassValue' holds the fields value and ensures that the JSON output is compatible with Passbook. -- To create a very simple key/value field containing text you can use the 'mkSimpleField' function.-data PassField = forall a . ToPassField a => PassField {+data PassField = PassField { -- standard field keys changeMessage :: Maybe Text -- ^ Message displayed when the pass is updated. May contain the @%\@@ placeholder for the value. (optional) , key :: Text -- ^ Must be a unique key within the scope of the pass (e.g. \"departure-gate\") (required) , label :: Maybe Text -- ^ Label text for the field. (optional) , textAlignment :: Maybe Alignment -- ^ Alignment for the field's contents. Not allowed for primary fields. (optional)- , value :: a -- ^ Value of the field. Must be a string, ISO 8601 date or a number. (required)+ , value :: PassValue -- ^ Value of the field. Must be a string, ISO 8601 date or a number. (required) -- Date style keys (all optional). If any key is present, the field will be treated as a date. , dateStyle :: Maybe DateTimeStyle -- ^ Style of date to display (optional)@@ -104,7 +133,7 @@ -- Number style keys (all optional). Not allowed if the field is not a number. , currencyCode :: Maybe Text -- ^ ISO 4217 currency code for the field's value (optional) , numberStyle :: Maybe NumberStyle -- ^ Style of number to display. See @NSNumberFormatterStyle@ docs for more information. (optional)-}+} deriving (Eq, Ord, Typeable) -- |BoardingPass transit type. Only necessary for Boarding Passes. data TransitType = Air@@ -112,18 +141,21 @@ | Bus | Train | GenericTransit---- |Newtype wrapper around 'UTCTime' with a 'ToJSON' instance that ensures Passbook-compatible--- time rendering. (ISO 8601)-newtype PassDate = PassDate UTCTime+ deriving (Eq, Ord, Typeable) --- |The type of a pass including the specific auxiliary, main, etc. fields+-- |The type of a pass including its fields data PassType = BoardingPass TransitType PassContent | Coupon PassContent | Event PassContent | GenericPass PassContent | StoreCard PassContent+ deriving (Eq, Ord, Typeable) +data WebService = WebService {+ authenticationToken :: Text -- ^ Authentication token for use with the web service. Must be 16 characters or longer (optional)+ , webServiceURL :: Text -- ^ The URL of a web service that conforms to the API described in the Passbook Web Service Reference (optional)+} deriving (Eq, Ord, Show, Typeable)+ -- |The fields within a pass data PassContent = PassContent { headerFields :: [PassField] -- ^ Fields to be displayed on the front of the pass. Always shown in the stack.@@ -131,13 +163,12 @@ , secondaryFields :: [PassField] -- ^ Fields to be displayed on the front of the pass. , auxiliaryFields :: [PassField] -- ^ Additional fields to be displayed on the front of the pass. , backFields :: [PassField] -- ^ Fields to be on the back of the pass.-}+} deriving (Eq, Ord, Typeable) -- |A complete pass data Pass = Pass { -- Required keys description :: Text -- ^ Brief description of the pass (required)- , formatVersion :: Int -- ^ Version of the file format. The value must be 1. (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)@@ -148,7 +179,7 @@ -- relevance keys , locations :: [Location] -- ^ Locations where the pass is relevant (e.g. that of a store) (optional)- , relevantDate :: Maybe PassDate -- ^ ISO 8601 formatted date for when the pass becomes relevant (optional)+ , relevantDate :: Maybe RelevantDate -- ^ ISO 8601 formatted date for when the pass becomes relevant (optional) -- visual appearance key , barcode :: Maybe Barcode -- ^ Barcode information (optional)@@ -159,17 +190,16 @@ , suppressStripShine :: Maybe Bool -- ^ If @True@, the strip image is displayed without a shine effect. (optional) -- web service keys- , authenticationToken :: Maybe Text -- ^ Authentication token for use with the web service. Must be 16 characters or longer (optional)- , webServiceURL :: Maybe Text -- ^ The URL of a web service that conforms to the API described in the Passbook Web Service Reference (optional)+ , webService :: Maybe WebService -- ^ Contains the authentication token (16 characters or longer) and the API end point for a Web Service , passContent :: PassType -- ^ The kind of pass and the passes' fields (required)-}+} deriving (Eq, Ord, Typeable) -- * JSON instances -- |Conditionally appends something wrapped in Maybe to a list of 'Pair'. This is necessary -- because Passbook can't deal with null values in JSON.-(-:) :: ToJSON a => Text -> Maybe a -> ([Pair] -> [Pair])+(-:) :: ToJSON a => Text -> Maybe a -> [Pair] -> [Pair] (-:) _ Nothing = id (-:) key (Just value) = ((key .= value) :) @@ -214,17 +244,17 @@ $ ("labelColor" -: labelColor) $ ("logoText" -: logoText) $ ("suppressStripShine" -: suppressStripShine)- $ ("authenticationToken" -: authenticationToken)- $ ("webServiceURL" -: webServiceURL)+ $ ("authenticationToken" -: fmap authenticationToken webService)+ $ ("webServiceURL" -: fmap webServiceURL webService) $ [ "description" .= description- , "formatVersion" .= (1 :: Int) -- Harcoding this because it should not be changed+ , "formatVersion" .= (1 :: Int) -- Hardcoding this because it should not be changed , "organizationName" .= organizationName , "passTypeIdentifier" .= passTypeIdentifier , "serialNumber" .= serialNumber , "teamIdentifier" .= teamIdentifier , "associatedStoreIdentifiers" .= associatedStoreIdentifiers , "locations" .= locations- , (pack $ show passContent) .= passContent]+ , pack (show passContent) .= passContent] in object pairs -- |Internal helper function to handle Boarding Passes correctly.@@ -256,6 +286,7 @@ instance ToJSON BarcodeFormat where toJSON QRCode = toJSON ("PKBarcodeFormatQR" :: Text) toJSON PDF417 = toJSON ("PKBarcodeFormatPDF417" :: Text)+ toJSON Aztec = toJSON ("PKBarcodeFormatAztec" :: Text) instance Show Alignment where show LeftAlign = "PKTextAlignmentLeft"@@ -285,7 +316,6 @@ instance ToJSON NumberStyle where toJSON = toJSON . pack . show - instance Show TransitType where show Air = "PKTransitTypeAir" show Boat = "PKTransitTypeBoat"@@ -296,14 +326,25 @@ instance ToJSON TransitType where toJSON = toJSON . pack . show -instance Show PassDate where- show (PassDate d) =- let timeFormat = iso8601DateFormat $ Just $ timeFmt defaultTimeLocale- in formatTime defaultTimeLocale timeFormat d+instance ToJSON PassValue where+ toJSON (PassInt i) = toJSON i+ toJSON (PassDouble d) = toJSON d+ toJSON (PassText t) = toJSON t+ toJSON (PassDate d) = jsonPassdate d -instance ToJSON PassDate where- toJSON = toJSON . pack . show+instance ToJSON RelevantDate where+ toJSON (RelevantDate d) = jsonPassdate d +-- | The ISO 8601 time/date encoding used by Passbook+timeFormat = iso8601DateFormat $ Just $ timeFmt defaultTimeLocale++-- |Correctly renders a @PassDate@ in JSON (ISO 8601)+jsonPassdate = toJSON . formatTime defaultTimeLocale timeFormat++-- |Helper function that parses a 'UTCTime' out of a Text+parseJsonDate :: Text -> Maybe UTCTime+parseJsonDate = parseTime defaultTimeLocale timeFormat . unpack+ instance Show PassType where show (BoardingPass _ _) = "boardingPass" show (Coupon _) = "coupon"@@ -311,6 +352,166 @@ show (GenericPass _) = "generic" show (StoreCard _) = "storeCard" +deriving instance Show PassField+deriving instance Show PassContent+deriving instance Show Pass++-- * Implementing FromJSON++instance FromJSON Alignment where+ parseJSON (String t) = case t of+ "PKTextAlignmentLeft" -> pure LeftAlign+ "PKTextAlignmentCenter" -> pure Center+ "PKTextAlignmentRight" -> pure RightAlign+ "PKTextAlignment" -> pure Natural+ _ -> fail "Could not parse text alignment style"+ parseJSON _ = mzero++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+ _ -> fail "Could not parse date formatting style"+ parseJSON _ = mzero++instance FromJSON NumberStyle where+ parseJSON (String t) = case t of+ "PKNumberStyleDecimal" -> pure Decimal+ "PKNumberStylePercent" -> pure Percent+ "PKNumberStyleScientific" -> pure Scientific+ "PKNumberStyleSpellOut" -> pure SpellOut+ _ -> fail "Could not parse number formatting style"+ parseJSON _ = mzero++instance FromJSON BarcodeFormat where+ parseJSON (String t) = case t of+ "PKBarcodeFormatQR" -> pure QRCode+ "PKBarcodeFormatAztec" -> pure Aztec+ "PKBarcodeFormatPDF417" -> pure PDF417+ _ -> fail "Could not parse barcode format"+ parseJSON _ = mzero++instance FromJSON TransitType where+ parseJSON (String t) = case t of+ "PKTransitTypeAir" -> pure Air+ "PKTransitTypeBoat" -> pure Boat+ "PKTransitTypeBus" -> pure Bus+ "PKTransitTypeTrain" -> pure Train+ "PKTransitTypeGeneric" -> pure GenericTransit+ _ -> fail "Could not parse transit type"+ parseJSON _ = mzero++instance FromJSON Location where+ parseJSON (Object v) = Location <$>+ v .: "latitude" <*>+ v .: "longitude" <*>+ v .:? "altitude" <*>+ v .:? "relevantText"+ parseJSON _ = mzero++instance FromJSON Barcode where+ parseJSON (Object v) = Barcode <$>+ v .:? "altText" <*>+ v .: "format" <*>+ v .: "message" <*>+ v .: "messageEncoding"+ parseJSON _ = mzero++instance FromJSON PassValue where+ parseJSON (Number (I i)) = pure $ PassInt i+ parseJSON (Number (D d)) = pure $ PassDouble d+ parseJSON (String t) = case parseJsonDate t of+ Just d -> pure $ PassDate d+ Nothing -> pure $ PassText t+ parseJSON _ = fail "Could not parse pass field value"++instance FromJSON PassField where+ parseJSON (Object v) =+ PassField <$>+ v .:? "changeMessage" <*>+ v .: "key" <*>+ v .:? "label" <*>+ v .:? "textAlignment" <*>+ v .: "value" <*>+ v .:? "dateStyle" <*>+ v .:? "timeStyle" <*>+ v .:? "isRelative" <*>+ v .:? "currencyCode" <*>+ v .:? "numberStyle"+ parseJSON _ = mzero++instance FromJSON RelevantDate where+ parseJSON (String t) = case parseJsonDate t of+ (Just d) -> pure $ RelevantDate d+ Nothing -> fail "Could not parse relevant date"+ parseJSON _ = mzero++$(deriveFromJSON id ''PassContent)++-- |Tries to parse a web service+parseWebService :: Maybe Text -> Maybe Text -> Maybe WebService+parseWebService Nothing _ = Nothing+parseWebService _ Nothing = Nothing+parseWebService (Just token) (Just url) = Just $ WebService token url++-- |Parses an RGBColor. This is not piped through 'rgb', thus it is not+-- checked whether the specified colour values are in range.+parseRGB :: Parser RGBColor+parseRGB = RGB <$> ("rgb(" .*> decimal)+ <*> ("," .*> decimal)+ <*> ("," .*> decimal)++instance FromJSON RGBColor where+ parseJSON (String t) = case parseOnly parseRGB t of+ Left f -> fail f+ Right r -> pure r+ parseJSON _ = mzero++instance FromJSON PassType where+ parseJSON (Object v)+ | HM.member "boardingPass" v =+ withValue "boardingPass" $ \val -> case val of+ Object o -> BoardingPass <$> o .: "transitType"+ <*> parseJSON val+ _ -> fail "Could not parse Boarding Pass"+ | HM.member "coupon" v =+ withValue "coupon" $ \o -> Coupon <$> parseJSON o+ | HM.member "eventTicket" v =+ withValue "eventTicket" $ \o -> Event <$> parseJSON o+ | HM.member "storeCard" v =+ withValue "storeCard" $ \o -> StoreCard <$> parseJSON o+ | HM.member "generic" v =+ withValue "generic" $ \o -> GenericPass <$> parseJSON o+ where+ withValue k f= f $ v HM.! k++instance FromJSON Pass where+ parseJSON o@(Object v) =+ Pass <$>+ v .: "description" <*>+ v .: "organizationName" <*>+ v .: "passTypeIdentifier" <*>+ v .: "serialNumber" <*>+ v .: "teamIdentifier" <*>+ v .: "associatedStoreIdentifiers" <*>+ v .: "locations" <*>+ v .:? "relevantDate" <*>+ v .:? "barcode" <*>+ v .:? "backgroundColor" <*>+ v .:? "foregroundColor" <*>+ v .:? "labelColor" <*>+ v .:? "logoText" <*>+ v .:? "suppressStripShine" <*>+ wbs <*>+ parseJSON o+ where+ wbs = parseWebService <$> v .:? "authenticationToken"+ <*> v .:? "webServiceURL"++ -- * Auxiliary functions -- |This function takes a 'Text' and a 'BarcodeFormat' and uses the text@@ -328,11 +529,9 @@ -- |Creates a simple 'PassField' with just a key, a value and an optional label. -- All the other optional fields are set to 'Nothing'.-mkSimpleField :: ToPassField a- => Text -- ^ Key- -> a -- ^ Value+mkSimpleField :: Text -- ^ Key+ -> PassValue -- ^ Value -> Maybe Text -- ^ Label -> PassField mkSimpleField k v l = PassField Nothing k l Nothing v Nothing Nothing Nothing Nothing Nothing-
hs-pkpass.cabal view
@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: hs-pkpass-version: 0.1.2.2+version: 0.2 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@@ -11,7 +11,7 @@ author: Vincent Ambo maintainer: geva@humac.com -- copyright: -category: iOS+category: Apple build-type: Simple cabal-version: >=1.8 @@ -19,24 +19,23 @@ type: git location: https://github.com/tazjin/hs-pkpass.git -source-repository this- type: git- location: https://github.com/tazjin/hs-pkpass/tree/v0.1- tag: 0.1-- library exposed-modules: Passbook, Passbook.Types -- 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.*,- directory ==1.1.*,- random ==1.0.*,+ random == 1.0.*, time ==1.4.*, old-locale ==1.0.*,- shakespeare-text ==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