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/locators.cabal b/locators.cabal new file mode 100644 --- /dev/null +++ b/locators.cabal @@ -0,0 +1,83 @@ +cabal-version: >= 1.10 +name: locators +version: 0.2.3.1 +synopsis: Human exchangable identifiers and locators +license: BSD3 +author: Andrew Cowie +maintainer: Andrew Cowie +copyright: © 2013 Operational Dynamics Consultin, Pty Ltd and Others +category: Other +tested-with: GHC == 7.6 +stability: experimental + +build-type: Simple + +library + default-language: Haskell2010 + + build-depends: base >= 4 && <5, + bytestring, + text, + containers, + cryptohash, + cereal + + hs-source-dirs: src + include-dirs: . + + exposed-modules: Data.Locator + other-modules: Data.Locator.Hashes, + Data.Locator.Locators + + + ghc-options: -O2 + -threaded + -Wall + -Wwarn + -fwarn-tabs + -funbox-strict-fields + -fno-warn-missing-signatures + -fno-warn-unused-do-bind + + ghc-prof-options: -prof -fprof-auto-top + + +test-suite check + type: exitcode-stdio-1.0 + + default-language: Haskell2010 + + build-depends: base >= 4 && <5, + HUnit, + hspec, + hspec-expectations, + QuickCheck, + bytestring, + text, + containers, + cryptohash, + cereal + + hs-source-dirs: src,tests + main-is: check.hs + + ghc-options: -O2 + -threaded + -Wall + -Wwarn + -fwarn-tabs + -funbox-strict-fields + -fno-warn-missing-signatures + -fno-warn-unused-do-bind + + include-dirs: . + + ghc-prof-options: -prof -fprof-auto-top + + +source-repository head + type: git + location: git@github.com:afcowie/locators.git + + +-- vim: set tabstop=21 expandtab: diff --git a/src/Data/Locator.hs b/src/Data/Locator.hs new file mode 100644 --- /dev/null +++ b/src/Data/Locator.hs @@ -0,0 +1,71 @@ +-- +-- Human exchangable identifiers and locators +-- +-- Copyright © 2011-2014 Operational Dynamics Consulting, Pty Ltd +-- +-- The code in this file, and the program it is a part of, is +-- made available to you by its authors as open source software: +-- you can redistribute it and/or modify it under the terms of +-- the BSD licence. +-- +-- This code originally licenced GPLv2. Relicenced BSD3 on 2 Jan 2014. +-- + +{-# LANGUAGE OverloadedStrings #-} + +-- +-- | +-- Maintainer: Andrew Cowie +-- Stability: Experimental +-- +-- /Background/ +-- +-- We had a need for identifiers that could be used by humans. +-- +-- The requirement to be able to say these over the phone complicates matters. +-- Most people have approached this problem by using a phonetic alphabet. The +-- trouble comes when you hear people saying stuff like \"A as in ... uh, +-- Apple?\" (should be Alpha, of course) and \"U as in ... um, what's a word +-- that starts with U?\" It gets worse. Ever been to a GPG keysigning? Listen +-- to people attempt to read out the digits of their key fingerprints. ...C 3 E +-- D 0 0 0 0 0 0 0 2 B D B D... \"Did you say \'C\' or \'D\'?\" and \"how +-- many zeros was that?\" Brutal. +-- +-- So what we need is a symbol set where each digit is unambigious and doesn't +-- collide with the phonetics of another symbol. This package provides +-- Locator16, a set of 16 letters and numbers that, when spoken in English, +-- have unique pronounciation. +-- +-- Also included is code to work in base 62, which is simply @[\'0\'@-@\'9\'@, +-- @\'A\'@-@\'Z\'@, and @\'a\'@-@\'z\']@. These are frequently used to express +-- short codes in URL redirectors; you may find them a more useful encoding for +-- expressing numbers than base 16 hexidecimal. +-- +module Data.Locator +( + -- * Locator16 + -- | This was somewhat inspired by the record locators used by the civilian + -- air travel industry, but with the restriction that the symbol set is + -- carefully chosen (aviation locators do heroic things like excluding + -- \'I\' but not much else) and, in the case of Locator16a, to not repeat + -- symbols. They're not a reversable encoding, but assuming you're just + -- generating identifiers and storing them somewhere, they're quite handy. + -- + -- @TODO@ /link to paper with pronunciation study when published./ + -- + Locator(..), + English16(..), + fromLocator16, + toLocator16, + toLocator16a, + hashStringToLocator16a, + + -- * Base62 + toBase62, + fromBase62, + hashStringToBase62 + +) where + +import Data.Locator.Hashes +import Data.Locator.Locators diff --git a/src/Data/Locator/Hashes.hs b/src/Data/Locator/Hashes.hs new file mode 100644 --- /dev/null +++ b/src/Data/Locator/Hashes.hs @@ -0,0 +1,106 @@ +-- +-- Human exchangable identifiers and locators +-- +-- Copyright © 2011-2014 Operational Dynamics Consulting, Pty Ltd +-- +-- The code in this file, and the program it is a part of, is +-- made available to you by its authors as open source software: +-- you can redistribute it and/or modify it under the terms of +-- the BSD licence. +-- +-- This code originally licenced GPLv2. Relicenced BSD3 on 2 Jan 2014. +-- + +{-# LANGUAGE OverloadedStrings #-} + +module Data.Locator.Hashes ( toBase62, fromBase62, hashStringToBase62) where + + +import Prelude hiding (toInteger) + +import Crypto.Hash.SHA1 as Crypto +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as S +import Data.Char (chr, isDigit, isLower, isUpper, ord) +import Data.Word +import Numeric (showIntAtBase) + +-- +-- Conversion between decimal and base 62 +-- + +represent :: Int -> Char +represent x + | x < 10 = chr (48 + x) + | x < 36 = chr (65 + x - 10) + | x < 62 = chr (97 + x - 36) + | otherwise = '@' + +toBase62 :: Integer -> String +toBase62 x = + showIntAtBase 62 represent x "" + +padWithZeros :: Int -> Integer -> String +padWithZeros digits x = + pad ++ str + where + pad = take len (replicate digits '0') + len = digits - length str + str = toBase62 x + + +value :: Char -> Int +value c + | isDigit c = ord c - 48 + | isUpper c = ord c - 65 + 10 + | isLower c = ord c - 97 + 36 + | otherwise = 0 + +multiply :: Integer -> Char -> Integer +multiply acc c = + acc * 62 + (fromIntegral $ value c) + +fromBase62 :: String -> Integer +fromBase62 ss = + foldl multiply 0 ss + + +concatToInteger :: [Word8] -> Integer +concatToInteger bytes = + foldl fn 0 bytes + where + fn acc b = (acc * 256) + (fromIntegral b) + + +digest :: String -> Integer +digest ws = + i + where + i = concatToInteger h + h = B.unpack h' + h' = Crypto.hash x' + x' = S.pack ws + + +-- +-- | Take an arbitrary string, hash it, then pad it with zeros up to be a +-- @digits@-long string in base 62. +-- +-- You may be interested to know that the 160-bit SHA1 hash used here can be +-- expressed without loss as 27 digits of base 62, for example: +-- +-- >>> hashStringToBase62 27 "Hello World" +-- 1T8Sj4C5jVU6iQXCwCwJEPSWX6u +-- +hashStringToBase62 :: Int -> ByteString -> ByteString +hashStringToBase62 digits s' = + r' + where + s = S.unpack s' + n = digest s -- SHA1 hash + limit = 62 ^ digits + x = mod n limit -- trim to specified number base62 chars + r = padWithZeros digits x -- convert to String + r' = S.pack r + diff --git a/src/Data/Locator/Locators.hs b/src/Data/Locator/Locators.hs new file mode 100644 --- /dev/null +++ b/src/Data/Locator/Locators.hs @@ -0,0 +1,291 @@ +-- +-- Human exchangable identifiers and locators +-- +-- Copyright © 2011-2014 Operational Dynamics Consulting, Pty Ltd +-- +-- The code in this file, and the program it is a part of, is +-- made available to you by its authors as open source software: +-- you can redistribute it and/or modify it under the terms of +-- the BSD licence. +-- +-- This code originally licenced GPLv2. Relicenced BSD3 on 2 Jan 2014. +-- + +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} + +module Data.Locator.Locators +( + Locator(..), + English16(..), + fromLocator16, + toLocator16, + toLocator16a, + hashStringToLocator16a +) where + + +import Prelude hiding (toInteger) + +import Crypto.Hash.SHA1 as Crypto +import Data.ByteString (ByteString) +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as S +import Data.List (mapAccumL) +import Data.Set (Set) +import qualified Data.Set as Set +import Data.Word +import Numeric (showIntAtBase) + + +-- +-- | A symbol set with sixteen uniquely pronounceable digits. +-- +-- The fact there are sixteen symbols is more an indication of a certain degree +-- of bullheaded-ness on the part of the author, and less of any kind of actual +-- requirement. We might have a slighly better readback score if we dropped to +-- 15 or 14 unique characters. It does mean you can match up with hexidecimal, +-- which is not entirely without merit. +-- +-- The grouping of letters and numbers was the hard part; having come up with +-- the set and deconflicted the choices, the ordering is then entirely +-- arbitrary. Since there are some numbers, might as well have them at the same +-- place they correspond to in base 10; the letters were then allocated in +-- alpha order in the remaining slots. +-- +{- + -- 0 Conflicts with @\'O\'@ obviously, and @\'Q\'@ often enough + -- + -- 2 @\'U\'@, @\'W\'@, and @\'2\'@. @\'W\'@ is disqualifed because of + -- the way Australians butcher double-this and triple-that. \"Double + -- @\'U\'@\" or \"@\'W\'@\"? + -- + -- C @\'B\'@, @\'C\'@, @\'D\'@, @\'E\'@, @\'G\'@, @\'P\'@, @\'T\'@, + -- @\'V\'@, and @\'3\'@ plus @\'Z\'@ because Americans can't pronounce + -- Zed properly. + -- + -- 4 @\'4\'@ and @\'5\'@ are often confused, and @\'5\'@, definitely + -- out due to its collision with @\'I\'@ when spoken and @\'S\'@ in + -- writing. + -- + -- F @\'F\'@ and @\'S\'@ are notoriously confused, making the choice of + -- @\'F\'@ borderline, but @\'S\'@ is already disqualified for looking + -- like @\'5\'@. + -- + -- K group of @\'A\'@, @\'J\'@, @\'K\'@. + -- + -- L @\'L\'@ has good phonetics, and as long as it's upper case (which + -- the whole 'English16' symbol set is) there's no conflict with + -- @\'1\'@. + -- + -- M choice from @\'M\'@ and @\'N\'@; the latter is a little too close + -- to @\'7\'@. + -- + -- X choice from @\'X\'@ and @\'6\'@. + -- + -- Y choice from @\'I\'@, @\'Y\'@, @\'5\'@. @\'I\'@ is out for the + -- usual reason of being similar to @\'1\'@. +-} +data English16 + = Zero -- ^ @\'0\'@ /0th/ + | One -- ^ @\'1\'@ /1st/ + | Two -- ^ @\'2\'@ /2nd/ + | Charlie -- ^ @\'C\'@ /3rd/ + | Four -- ^ @\'4\'@ /4th/ + | Foxtrot -- ^ @\'F\'@ /5th/ + | Hotel -- ^ @\'H\'@ /6th/ + | Seven -- ^ @\'7\'@ /7th/ + | Eight -- ^ @\'8\'@ /8th/ + | Nine -- ^ @\'9\'@ /9th/ + | Kilo -- ^ @\'K\'@ /10th/ + | Lima -- ^ @\'L\'@ /11th/ + | Mike -- ^ @\'M\'@ /12th/ + | Romeo -- ^ @\'R\'@ /13th/ + | XRay -- ^ @\'X\'@ /14th/ + | Yankee -- ^ @\'Y\'@ /15th/ + deriving (Eq, Ord, Enum, Bounded) + + +class (Ord α, Enum α, Bounded α) => Locator α where + locatorToDigit :: α -> Char + digitToLocator :: Char -> α + + +instance Locator English16 where + +-- locatorToDigit :: English16 -> Char + locatorToDigit x = + case x of + Zero -> '0' + One -> '1' + Two -> '2' + Charlie -> 'C' + Four -> '4' + Foxtrot -> 'F' + Hotel -> 'H' + Seven -> '7' + Eight -> '8' + Nine -> '9' + Kilo -> 'K' + Lima -> 'L' + Mike -> 'M' + Romeo -> 'R' + XRay -> 'X' + Yankee -> 'Y' + +-- digitToLocator :: Char -> English16 + digitToLocator c = + case c of + '0' -> Zero + '1' -> One + '2' -> Two + 'C' -> Charlie + '4' -> Four + 'F' -> Foxtrot + 'H' -> Hotel + '7' -> Seven + '8' -> Eight + '9' -> Nine + 'K' -> Kilo + 'L' -> Lima + 'M' -> Mike + 'R' -> Romeo + 'X' -> XRay + 'Y' -> Yankee + _ -> error "Illegal digit" + + + +represent :: Int -> Char +represent n = + locatorToDigit $ (toEnum n :: English16) -- FIXME + + +instance Show English16 where + show x = [c] + where + c = locatorToDigit x + + + + +value :: Char -> Int +value c = + fromEnum $ (digitToLocator c :: English16) -- FIXME + + + +-- +-- | Given a number, convert it to a string in the Locator16 base 16 symbol +-- alphabet. You can use this as a replacement for the standard \'0\'-\'9\' +-- \'A\'-\'F\' symbols traditionally used to express hexidemimal, though really +-- the fact that we came up with 16 total unique symbols was a nice +-- co-incidence, not a requirement. +-- +toLocator16 :: Int -> String +toLocator16 x = + showIntAtBase 16 represent x "" + + +-- +-- | Represent a number in Locator16a format. This uses the Locator16 symbol +-- set, and additionally specifies that no symbol can be repeated. The /a/ in +-- Locator16a represents that this transformation is done on the cheap; when +-- converting if we end up with \'9\' \'9\' we simply pick the subsequent digit +-- in the enum, in this case getting you \'9\' \'K\'. +-- +-- Note that the transformation is /not/ reversible. A number like @4369@ +-- (which is @0x1111@, incidentally) encodes as @12C4@. So do @4370@, @4371@, +-- and @4372@. The point is not uniqueness, but readibility in adverse +-- conditions. So while you can count locators, they don't map continuously to +-- base10 integers. +-- +-- The first argument is the number of digits you'd like in the locator; if the +-- number passed in is less than 16^limit, then the result will be padded. +-- +-- >>> toLocator16a 6 4369 +-- 12C40F +-- +toLocator16a :: Int -> Int -> String +toLocator16a limit n = + let + ls = convert n (replicate limit minBound) :: [English16] + (_,us) = mapAccumL uniq Set.empty ls + in + map locatorToDigit (take limit us) + where + convert :: Locator α => Int -> [α] -> [α] + convert 0 xs = xs + convert i xs = + let + (d,r) = divMod i 16 + x = toEnum r + in + convert d (x:xs) + + uniq :: Locator α => Set α -> α -> (Set α, α) + uniq s x = + if Set.member x s + then uniq s (subsequent x) + else (Set.insert x s, x) + + subsequent :: Locator α => α -> α + subsequent x = + if x == maxBound + then minBound + else succ x + + +multiply :: Int -> Char -> Int +multiply acc c = + acc * 16 + value c + +-- +-- | Given a number encoded in Locator16, convert it back to an integer. +-- +fromLocator16 :: String -> Int +fromLocator16 ss = + foldl multiply 0 ss + + +-- +-- Given a string, convert it into a N character hash. +-- + +concatToInteger :: [Word8] -> Int +concatToInteger bytes = + foldl fn 0 bytes + where + fn acc b = (acc * 256) + (fromIntegral b) + +digest :: String -> Int +digest ws = + i + where + i = concatToInteger h + h = B.unpack h' + h' = Crypto.hash x' + x' = S.pack ws + + +-- +-- | Take an arbitrary sequence of bytes, hash it with SHA1, then format as a +-- short @digits@-long Locator16 string. +-- +-- >>> hashStringToLocator16a 6 "Hello World" +-- M48HR0 +-- + +hashStringToLocator16a :: Int -> ByteString -> ByteString +hashStringToLocator16a limit s' = + let + s = S.unpack s' + n = digest s -- SHA1 hash + r = mod n upperBound -- trim to specified number of base 16 chars + x = toLocator16a limit r -- express in locator16 + b' = S.pack x + in + b' + where + upperBound = 16 ^ limit + diff --git a/tests/check.hs b/tests/check.hs new file mode 100644 --- /dev/null +++ b/tests/check.hs @@ -0,0 +1,20 @@ +-- +-- Human exchangable identifiers and locators +-- +-- Copyright © 2013-2014 Operational Dynamics Consulting, Pty Ltd +-- +-- The code in this file, and the program it is a part of, is +-- made available to you by its authors as open source software: +-- you can redistribute it and/or modify it under the terms of +-- the BSD licence. +-- + +module Main where + +import Test.Hspec (hspec) + +import TestSuite (suite) + +main :: IO () +main = do + hspec suite