diff --git a/lib/Data/Locator.hs b/lib/Data/Locator.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Locator.hs @@ -0,0 +1,72 @@ +-- +-- Human exchangable identifiers and locators +-- +-- Copyright © 2011-2017 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, + padWithZeros, + hashStringToBase62 + +) where + +import Data.Locator.Hashes +import Data.Locator.Locators diff --git a/lib/Data/Locator/Hashes.hs b/lib/Data/Locator/Hashes.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Locator/Hashes.hs @@ -0,0 +1,119 @@ +-- +-- Human exchangable identifiers and locators +-- +-- Copyright © 2011-2017 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, + padWithZeros, + 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 "" + +-- +-- | Utility function to prepend \'0\' characters to a string representing a +-- number. This allows you to ensure a fixed width for numbers that are less +-- than the desired width in size. This comes up frequently when representing +-- numbers in other bases greater than 10 as they are inevitably presented as +-- text, and not having them evenly justified can (at best) be ugly and (at +-- worst) actually lead to parsing and conversion bugs. +-- +padWithZeros :: Int -> String -> String +padWithZeros digits str = + pad ++ str + where + pad = take len (replicate digits '0') + len = digits - length str + + +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 + str = toBase62 x + r = padWithZeros digits str -- convert to String + r' = S.pack r + diff --git a/lib/Data/Locator/Locators.hs b/lib/Data/Locator/Locators.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Locator/Locators.hs @@ -0,0 +1,292 @@ +-- +-- Human exchangable identifiers and locators +-- +-- Copyright © 2011-2017 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 + n' = abs n + 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/locators.cabal b/locators.cabal --- a/locators.cabal +++ b/locators.cabal @@ -1,6 +1,6 @@ -cabal-version: >= 1.10 +cabal-version: 1.24 name: locators -version: 0.2.4.3 +version: 0.2.4.4 synopsis: Human exchangable identifiers and locators license: BSD3 license-file: LICENCE @@ -15,7 +15,7 @@ maintainer: Andrew Cowie copyright: © 2013-2018 Operational Dynamics Consulting, Pty Ltd and Others category: Other -tested-with: GHC == 8.2 +tested-with: GHC == 8.2.2, GHC == 8.4.2 stability: experimental build-type: Simple @@ -26,10 +26,9 @@ build-depends: base >= 4 && <5, bytestring, containers, - cryptohash, - cereal + cryptohash - hs-source-dirs: src + hs-source-dirs: lib include-dirs: . exposed-modules: Data.Locator @@ -55,12 +54,10 @@ build-depends: base >= 4 && <5, HUnit, hspec, - hspec-expectations, QuickCheck, bytestring, containers, cryptohash, - cereal, locators hs-source-dirs: tests diff --git a/src/Data/Locator.hs b/src/Data/Locator.hs deleted file mode 100644 --- a/src/Data/Locator.hs +++ /dev/null @@ -1,72 +0,0 @@ --- --- Human exchangable identifiers and locators --- --- Copyright © 2011-2017 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, - padWithZeros, - hashStringToBase62 - -) where - -import Data.Locator.Hashes -import Data.Locator.Locators diff --git a/src/Data/Locator/Hashes.hs b/src/Data/Locator/Hashes.hs deleted file mode 100644 --- a/src/Data/Locator/Hashes.hs +++ /dev/null @@ -1,119 +0,0 @@ --- --- Human exchangable identifiers and locators --- --- Copyright © 2011-2017 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, - padWithZeros, - 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 "" - --- --- | Utility function to prepend \'0\' characters to a string representing a --- number. This allows you to ensure a fixed width for numbers that are less --- than the desired width in size. This comes up frequently when representing --- numbers in other bases greater than 10 as they are inevitably presented as --- text, and not having them evenly justified can (at best) be ugly and (at --- worst) actually lead to parsing and conversion bugs. --- -padWithZeros :: Int -> String -> String -padWithZeros digits str = - pad ++ str - where - pad = take len (replicate digits '0') - len = digits - length str - - -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 - str = toBase62 x - r = padWithZeros digits str -- convert to String - r' = S.pack r - diff --git a/src/Data/Locator/Locators.hs b/src/Data/Locator/Locators.hs deleted file mode 100644 --- a/src/Data/Locator/Locators.hs +++ /dev/null @@ -1,292 +0,0 @@ --- --- Human exchangable identifiers and locators --- --- Copyright © 2011-2017 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 - n' = abs n - 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/TestSuite.hs b/tests/TestSuite.hs --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -69,23 +69,23 @@ -- testKnownLocator16a = it "constrains Locator16a to unique digits" $ do - assertEqual "Incorrect result" "12C4FH" (toLocator16a 6 0x111111) - assertEqual "Incorrect result" "789KLM" (toLocator16a 6 0x777777) - assertEqual "Incorrect result" "MRXY01" (toLocator16a 6 0xCCCCCC) + toLocator16a 6 0x111111 `shouldBe` "12C4FH" + toLocator16a 6 0x777777 `shouldBe` "789KLM" + toLocator16a 6 0xCCCCCC `shouldBe` "MRXY01" testProblematicEdgeCases = it "converstion to Locator16a correct on corner cases" $ do - assertEqual "Incorrect result" "012C4F" (toLocator16a 6 0x0) - assertEqual "Incorrect result" "FHL417" (hashStringToLocator16a 6 "perf_data") - assertEqual "Incorrect result" "K48F01" (hashStringToLocator16a 6 "perf_data/bletchley") + toLocator16a 6 0x0 `shouldBe` "012C4F" + hashStringToLocator16a 6 "perf_data" `shouldBe` "FHL417" + hashStringToLocator16a 6 "perf_data/bletchley" `shouldBe` "K48F01" testPaddingRefactored = it "correctly pads strings" $ do - assertEqual "Incorrect result" "00001" (padWithZeros 5 "1") - assertEqual "Incorrect result" "123456" (padWithZeros 5 "123456") - assertEqual "Incorrect result" "LygHa16AHYG" (padWithZeros 11 . toBase62 $ 2^64) - assertEqual "Incorrect result" "k8SQgkJtxLo" (hashStringToBase62 11 . S.pack . show $ 2^64) + padWithZeros 5 "1" `shouldBe` "00001" + padWithZeros 5 "123456" `shouldBe` "123456" + (padWithZeros 11 . toBase62 $ 2^64) `shouldBe` "LygHa16AHYG" + (hashStringToBase62 11 . S.pack . show $ 2^64) `shouldBe` "k8SQgkJtxLo" testNegativeNumbers = it "doesn't explode if fed a negative number" $ do - assertEqual "Incorrect outcome" "1" (toLocator16a 1 (-1)) + toLocator16a 1 (-1) `shouldBe` "1"