diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, Vincent Ambo + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Vincent Ambo nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Passbook.hs b/Passbook.hs new file mode 100644 --- /dev/null +++ b/Passbook.hs @@ -0,0 +1,122 @@ +{-# LANGUAGE ExtendedDefaultRules #-} +{-# LANGUAGE OverloadedStrings #-} +{-# OPTIONS_GHC -fno-warn-type-defaults #-} + + +{- |This module provides different functions to sign a 'Pass' using Apple's @signpass@ + command-line tool. + + 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. + + 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. + + The funciton 'signpassWithModifier' creates a random UUID during the signing process, + passes this UUID on to a function that modifies the pass accordingly (e.g. sets the serial + number or the barcode payload to the UUID) and otherwise works like 'signpass'. + + The function, 'signpassWithId', takes an existing ID and signs the pass + using that for the serial number and file name. This will most likely be used + for updating existing passes. + + Using the function is very simple, assuming you have created a 'Pass' called + @myPass@ and you have the related assets (e.g. the logo.png and icon.png files) + stored in a folder named @myPass/@. + + You want the signed pass to be stored in a folder called @passes/@. You call + 'signpass' like this: + + > (path, passId) <- signpass "myPass" "passes" myPass + + You will find the pass at @path@ with the filename @passId.pkpass@. Using the + types from "Passbook.Types" ensures that passes are generated correctly. + + The @signpass@ utility must have access to your Keychain to be able to retrieve + your Pass Type Certificate for the pass to sign. You should run it once outside + of any program to grant it full access to your Keychain. + + Please note that an @icon.png@ file /must be/ present in your asset folder, + otherwise the generated pass will not work. + + Refer to Apple's Passbook documentation at + for more information or to retrieve the @signpass@ tool which is included in the + Passbook Support Materials. (iOS Developer Membership necessary) + + This module will most likely only work on OS X machines. +-} +module Passbook (signpass, signpassWithId, genPassId) where + +import Data.Aeson +import Data.Conduit +import Data.Conduit.Binary hiding (sinkFile) +import Data.Conduit.Filesystem +import qualified Data.Text as ST +import Data.Text.Lazy as LT +import Data.UUID +import Passbook.Types +import Prelude hiding (FilePath) +import Shelly +import System.Directory (doesFileExist) +import System.Random +default (LT.Text) + +-- |Takes the filepaths to the folder containing the path assets +-- and the output folder, a 'Pass' and uses a random UUID to +-- create and sign the pass. +signpass :: FilePath -- ^ Input file path (asset directory) + -> FilePath -- ^ Output file path + -> Pass -- ^ The pass to sign + -> IO (FilePath, ST.Text) -- ^ The filepath of the signed .pkpass and its UUID +signpass passIn passOut pass = do + passId <- genPassId + passPath <- signpassWithId passId passIn passOut pass + return (passPath, passId) + +-- |Works like 'signpass', except for the fourth argument which is a +-- modifier function that updates the pass with the generated UUID. +-- This is useful for cases where you want to store the UUID in the barcode +-- or some other field on the pass as well. +signpassWithModifier :: FilePath -- ^ Input file path (asset directory) + -> FilePath -- ^ Output file path + -> Pass -- ^ The pass to sign + -> (ST.Text -> Pass -> Pass) -- ^ Modifier function + -> IO (FilePath, ST.Text) -- ^ The filepath of the signed .pkpass and its UUID +signpassWithModifier passIn passOut pass modifier = do + passId <- genPassId + passPath <- signpassWithId passId passIn passOut $ modifier passId pass + return (passPath, passId) + +-- |Creates and signs a 'Pass' with an existing ID. +signpassWithId :: ST.Text -- ^ The pass ID + -> FilePath -- ^ Input file path (asset directory) + -> FilePath -- ^ Output file path + -> Pass -- ^ The pass to sign + -> IO FilePath +signpassWithId passId passIn passOut pass = shelly $ do + let tmp = passOut passId + lazyId = fromStrict passId + cp_r passIn tmp + liftIO $ renderPass (tmp "pass.json") pass { serialNumber = passId } + signcmd lazyId tmp passOut + rm_rf tmp + 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 + +-- |Render and store a pass.json at the desired location. +renderPass :: FilePath -> Pass -> IO () +renderPass path pass = + let rendered = sourceLbs $ encode pass + in runResourceT $ rendered $$ sinkFile path + +-- |Call the signpass tool. +signcmd :: Text -- ^ The pass identifier / serial number to uniquely identify the pass + -> FilePath -- ^ The temporary asset folder. + -> FilePath -- ^ The output folder for all .pkpass files + -> 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 diff --git a/Passbook/Types.hs b/Passbook/Types.hs new file mode 100644 --- /dev/null +++ b/Passbook/Types.hs @@ -0,0 +1,338 @@ +{-# LANGUAGE ExistentialQuantification #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE RecordWildCards #-} +{-# 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 + . + + + It ensures that passes are created correctly wherever possible. Currently, NSBundle localization is not supported. +-} +module Passbook.Types where + +import Data.Aeson +import Data.Aeson.TH +import Data.Aeson.Types +import Data.Text (Text, pack) +import Data.Time +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 + +-- * Passbook data types + +type Encoding = Text +type Message = Text + +-- |A location field +data Location = Location { + latitude :: Double -- ^ Latitude, in degrees, of the location (required) + , 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) +} + +-- |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 + +-- |Barcode is constructed by a Barcode format, an encoding +-- type and the Barcode message. +data BarcodeFormat = QRCode + | PDF417 + | Aztec + +-- |A pass barcode. In most cases the helper function 'mkBarcode' should be sufficient. +data Barcode = Barcode { + altText :: Maybe Text -- ^ Text displayed near the barcode (optional) + , 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) +} + +-- |Pass field alignment +data Alignment = LeftAlign + | Center + | RightAlign + | Natural + +-- |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@ + +-- |Pass field number display style +data NumberStyle = Decimal + | Percent + | Scientific + | SpellOut + +-- |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. +-- To create a very simple key/value field containing text you can use the 'mkSimpleField' function. +data PassField = forall a . ToPassField a => 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) + + -- 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) + , timeStyle :: Maybe DateTimeStyle -- ^ Style of time to display (optional) + , isRelative :: Maybe Bool -- ^ Is the date/time displayed relative to the current time or absolute? Default: @False@ (optional) + + -- 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) +} + +-- |BoardingPass transit type. Only necessary for Boarding Passes. +data TransitType = Air + | Boat + | Bus + | Train + | GenericTransit + +-- |Newtype wrapper around 'UTCTime' with a 'ToJSON' instance that ensures Passbook-compatible +-- time rendering. (ISO 8601) +newtype PassDate = PassDate UTCTime + +-- |The type of a pass including the specific auxiliary, main, etc. fields +data PassType = BoardingPass TransitType PassContent + | Coupon PassContent + | Event PassContent + | GenericPass PassContent + | StoreCard PassContent + +-- |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. + , primaryFields :: [PassField] -- ^ Fields to be displayed prominently on the front of the pass. + , 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. +} + +-- |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) + , teamIdentifier :: Text -- ^ Team identifier for the organization (required) + + -- associated app keys + , associatedStoreIdentifiers :: [Text] -- ^ A list of iTunes Store item identifiers for associated apps (optional) + + -- 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) + + -- visual appearance key + , barcode :: Maybe Barcode -- ^ Barcode information (optional) + , backgroundColor :: Maybe RGBColor -- ^ Background color of the pass (optional) + , foregroundColor :: Maybe RGBColor -- ^ Foreground color of the pass (optional) + , labelColor :: Maybe Text -- ^ Color of the label text. If omitted, the color is determined automatically. (optional) + , logoText :: Maybe Text -- ^ Text displayed next to the logo on the pass (optional) + , 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) + + , passContent :: PassType -- ^ The kind of pass and the passes' fields (required) +} + +-- * 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]) +(-:) _ Nothing = id +(-:) key (Just value) = ((key .= value) :) + +$(deriveToJSON id ''PassContent) + +instance ToJSON Location where + toJSON Location{..} = + let pairs = ("altitude" -: altitude) + $ ("relevantText" -: relevantText) + $ ["latitude" .= latitude + ,"longitude" .= longitude] + in object pairs + +instance ToJSON Barcode where + toJSON Barcode{..} = + let pairs = ("altText" -: altText) + $ [ "format" .= format + , "message" .= message + , "messageEncoding" .= messageEncoding ] + in object pairs + +instance ToJSON PassField where + toJSON PassField{..} = + let pairs = ("changeMessage" -: changeMessage) + $ ("label" -: label) + $ ("textAlignment" -: textAlignment) + $ ("dateStyle" -: dateStyle) + $ ("timeStyle" -: timeStyle) + $ ("isRelative" -: isRelative) + $ ("currencyCode" -: currencyCode) + $ ("numberStyle" -: numberStyle) + $ ["key" .= key, "value" .= value] + in object pairs + + +instance ToJSON Pass where + toJSON Pass{..} = + let pairs = ("relevantDate" -: relevantDate) + $ ("barcode" -: barcode) + $ ("backgroundColor" -: backgroundColor) + $ ("foregroundColor" -: foregroundColor) + $ ("labelColor" -: labelColor) + $ ("logoText" -: logoText) + $ ("suppressStripShine" -: suppressStripShine) + $ ("authenticationToken" -: authenticationToken) + $ ("webServiceURL" -: webServiceURL) + $ [ "description" .= description + , "formatVersion" .= (1 :: Int) -- Harcoding this because it should not be changed + , "organizationName" .= organizationName + , "passTypeIdentifier" .= passTypeIdentifier + , "serialNumber" .= serialNumber + , "teamIdentifier" .= teamIdentifier + , "associatedStoreIdentifiers" .= associatedStoreIdentifiers + , "locations" .= locations + , (pack $ show passContent) .= passContent] + in object pairs + +-- |Internal helper function to handle Boarding Passes correctly. +getPassContent :: PassType -> PassContent +getPassContent pc = case pc of + BoardingPass _ pc -> pc + Coupon pc -> pc + Event pc -> pc + GenericPass pc -> pc + StoreCard pc -> pc + +instance ToJSON PassType where + toJSON (BoardingPass tt PassContent{..}) = object [ + "transitType" .= tt + , "headerFields" .= headerFields + , "primaryFields" .= primaryFields + , "secondaryFields" .= secondaryFields + , "auxiliaryFields" .= auxiliaryFields + , "backFields" .= backFields ] + toJSON pt = toJSON $ getPassContent pt + +-- |Internal helper function +renderRGB :: RGBColor -> Text +renderRGB (RGB r g b) = [st|rgb(#{show r},#{show g},#{show b})|] + +instance ToJSON RGBColor where + toJSON = toJSON . renderRGB + +instance ToJSON BarcodeFormat where + toJSON QRCode = toJSON ("PKBarcodeFormatQR" :: Text) + toJSON PDF417 = toJSON ("PKBarcodeFormatPDF417" :: Text) + +instance Show Alignment where + show LeftAlign = "PKTextAlignmentLeft" + show Center = "PKTextAlignmentCenter" + show RightAlign = "PKTextAlignmentRight" + show Natural = "PKTextAlignment" + +instance ToJSON Alignment where + toJSON = toJSON . pack . show + +instance Show DateTimeStyle where + show None = "NSDateFormatterNoStyle" + show Short = "NSDateFormatterShortStyle" + show Medium = "NSDateFormatterMediumStyle" + show Long = "NSDateFormatterLongStyle" + show Full = "NSDateFormatterFullStyle" + +instance ToJSON DateTimeStyle where + toJSON = toJSON . pack . show + +instance Show NumberStyle where + show Decimal = "PKNumberStyleDecimal" + show Percent = "PKNumberStylePercent" + show Scientific = "PKNumberStyleScientific" + show SpellOut = "PKNumberStyleSpellOut" + +instance ToJSON NumberStyle where + toJSON = toJSON . pack . show + + +instance Show TransitType where + show Air = "PKTransitTypeAir" + show Boat = "PKTransitTypeBoat" + show Bus = "PKTransitTypeBus" + show Train = "PKTransitTypeTrain" + show GenericTransit = "PKTransitTypeGeneric" + +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 PassDate where + toJSON = toJSON . pack . show + +instance Show PassType where + show (BoardingPass _ _) = "boardingPass" + show (Coupon _) = "coupon" + show (Event _) = "eventTicket" + show (GenericPass _) = "generic" + show (StoreCard _) = "storeCard" + +-- * Auxiliary functions + +-- |This function takes a 'Text' and a 'BarcodeFormat' and uses the text +-- for both the barcode message and the alternative text. +mkBarcode :: Text -> BarcodeFormat -> Barcode +mkBarcode m f = Barcode (Just m) f m "iso-8859-1" + + +-- |Creates a @Just RGBColor@ if all supplied numbers are between 0 and 255. +rgb :: (Int, Int, Int) -> Maybe RGBColor +rgb (r, g, b) | isInRange r && isInRange b && isInRange b = Just $ RGB r g b + | otherwise = Nothing + where + isInRange x = 0 <= x && x <= 255 + +-- |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 + -> Maybe Text -- ^ Label + -> PassField +mkSimpleField k v l = PassField Nothing k l Nothing v Nothing Nothing + Nothing Nothing Nothing + diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hs-pkpass.cabal b/hs-pkpass.cabal new file mode 100644 --- /dev/null +++ b/hs-pkpass.cabal @@ -0,0 +1,42 @@ +-- Initial hs-pkpass.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: hs-pkpass +version: 0.1.0.0 +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: +category: iOS +build-type: Simple +cabal-version: >=1.8 + +source-repository head + 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.*, + 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.*, + time ==1.4.*, + old-locale ==1.0.*, + shakespeare-text ==1.0.*