diff --git a/Passbook.hs b/Passbook.hs --- a/Passbook.hs +++ b/Passbook.hs @@ -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 diff --git a/Passbook/Types.hs b/Passbook/Types.hs --- a/Passbook/Types.hs +++ b/Passbook/Types.hs @@ -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 - diff --git a/hs-pkpass.cabal b/hs-pkpass.cabal --- a/hs-pkpass.cabal +++ b/hs-pkpass.cabal @@ -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