diff --git a/LICENCE b/LICENCE deleted file mode 100644 --- a/LICENCE +++ /dev/null @@ -1,32 +0,0 @@ -Human exchangable identifiers and locators - -Copyright © 2013-2018 Operational Dynamics Consulting, Pty Ltd -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: - - 1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. - - 2. 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. - - 3. Neither the name of the project nor the names of its 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/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,19 @@ +Copyright © 2013-2020 Athae Eredh Siniath and Others + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the "Software"), +to deal in the Software without restriction, including without limitation +the rights to use, copy, modify, merge, publish, distribute, sublicense, +and/or sell copies of the Software, and to permit persons to whom the +Software is furnished to do so, subject to the following conditions: + +The above copyright notice and this permission notice shall be included in +all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE +AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +DEALINGS IN THE SOFTWARE. diff --git a/lib/Data/Locator.hs b/lib/Data/Locator.hs --- a/lib/Data/Locator.hs +++ b/lib/Data/Locator.hs @@ -1,7 +1,7 @@ -- -- Human exchangable identifiers and locators -- --- Copyright © 2011-2017 Operational Dynamics Consulting, Pty Ltd +-- Copyright © 2011-2018 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: @@ -33,17 +33,26 @@ -- -- 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. +-- 'English16', a set of 16 letters and numbers that, when spoken in /English/, +-- have unique pronounciation and have been very successful in verbal +-- communications over noisy links. -- --- 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. +-- Ironically, however, when used in written applications the English16 set is +-- a bit restrictive. When /looking/ at them they don't have much variety (it +-- turned out they're very blocky—so much so you have to squint). If the +-- application is transcription or identification visually then the criteria is +-- shapes that are distinct, rather than their sound. For these uses we provide +-- 'Latin25', a set of 25 symbols useful for identifiers in automated systems +-- that nevertheless have to be operated or debugged by humans. -- +-- Finally, 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 + -- * English16: locators humans can exchange -- | 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 @@ -53,20 +62,35 @@ -- -- @TODO@ /link to paper with pronunciation study when published./ -- - Locator(..), - English16(..), - fromLocator16, - toLocator16, - toLocator16a, - hashStringToLocator16a, + Locator(..) + , English16(..) + , fromEnglish16 + , toEnglish16 + , toEnglish16a + , hashStringToEnglish16a - -- * Base62 - toBase62, - fromBase62, - padWithZeros, - hashStringToBase62 + -- * Latin25: a visually distinct character set + -- An althernate character set chosen for visual distinctiveness (rather + -- than the aural distinctiveness goal of "English16"). + , Latin25(..) + , fromLatin25 + , toLatin25 + , hashStringToLatin25 + -- * Base62: binary without punctuation + , toBase62 + , fromBase62 + , padWithZeros + , hashStringToBase62 + + -- * Deprecated functions + , fromLocator16 + , toLocator16 + , toLocator16a + , hashStringToLocator16a ) where +import Data.Locator.Common import Data.Locator.Hashes -import Data.Locator.Locators +import Data.Locator.English16 +import Data.Locator.Latin25 diff --git a/lib/Data/Locator/Common.hs b/lib/Data/Locator/Common.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Locator/Common.hs @@ -0,0 +1,138 @@ +-- +-- Human exchangable identifiers and locators +-- +-- Copyright © 2011-2018 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 #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TypeApplications #-} + +module Data.Locator.Common + ( Locator(..) + , represent + , value + , toLocatorUnique + , multiply + , fromLocator + , concatToInteger + , digest + ) where + +import Prelude hiding (toInteger) + +import Crypto.Hash.SHA1 as Crypto +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 + +class (Ord α, Enum α, Bounded α) => Locator α where + locatorToDigit :: α -> Char + digitToLocator :: Char -> α + + +represent :: Locator α => α -> Int -> Char +represent (_ :: α) n = + locatorToDigit $ (toEnum n :: α) + +{- +value :: Locator α => α -> Char -> Int +value c (_ :: α) = + fromEnum $ (digitToLocator c :: α) +-} + +value :: Locator α => α -> Char -> Int +value (_ :: α) c = + fromEnum $ (digitToLocator c :: α) + +-- +-- | 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 +-- +toLocatorUnique :: Locator α => Int -> Int -> α -> String +toLocatorUnique limit n (_ :: α) = + let + n' = abs n + ls = convert n' (replicate limit (minBound @α)) + (_,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 :: Locator α => α -> Int -> Char -> Int +multiply (locator :: a) acc c = + let + base = fromEnum (maxBound @a) + 1 + in + (acc * base) + (value locator c) + +-- +-- | Given a number encoded as a Locator, convert it back to an integer. +-- +fromLocator :: Locator α => α -> String -> Int +fromLocator locator ss = + foldl (multiply locator) 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 + diff --git a/lib/Data/Locator/English16.hs b/lib/Data/Locator/English16.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Locator/English16.hs @@ -0,0 +1,263 @@ +-- +-- Human exchangable identifiers and locators +-- +-- Copyright © 2011-2018 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 #-} +{-# LANGUAGE InstanceSigs #-} +{-# LANGUAGE TypeApplications #-} + +module Data.Locator.English16 + ( Locator(..) + , English16(..) + , fromEnglish16 + , toEnglish16 + , toEnglish16a + , hashStringToEnglish16a + + -- Deprecated + , fromLocator16 + , toLocator16 + , toLocator16a + , hashStringToLocator16a + ) where + +import Prelude hiding (toInteger) + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as S +import Data.List (mapAccumL) +import Data.Set (Set) +import qualified Data.Set as Set +import Numeric (showIntAtBase) + +import Data.Locator.Common + +-- +-- | 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) + +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" + +instance Show English16 where + show x = [c] + where + c = locatorToDigit x + +-- +-- | Given a number, convert it to a string in the English16 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. +-- +toEnglish16 :: Int -> String +toEnglish16 x = + showIntAtBase 16 (represent Yankee) x "" + +-- +-- | Represent a number in English16a 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. +-- +-- >>> toEnglish16a 6 4369 +-- 12C40F +-- +toEnglish16a :: Int -> Int -> String +toEnglish16a limit n + | limit > 16 = error "Can only request a maximum of 16 English16a characters, not " ++ (show limit) + | otherwise = + 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 + +-- +-- | Given a number encoded in Locator16, convert it back to an integer. +-- +fromEnglish16 :: [Char] -> Int +fromEnglish16 ss = + foldl (multiply Yankee) 0 ss + +-- +-- | Take an arbitrary sequence of bytes, hash it with SHA1, then format as a +-- short @digits@-long Locator16 string. +-- +-- >>> hashStringToLocator16a 6 "Hello World" +-- M48HR0 +-- +hashStringToEnglish16a :: Int -> ByteString -> ByteString +hashStringToEnglish16a 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 + + +toLocator16 :: Int -> String +toLocator16 = toEnglish16 +{-# DEPRECATED toLocator16 "Use toEnglish16 instead" #-} + +toLocator16a :: Int -> Int -> String +toLocator16a = toEnglish16a +{-# DEPRECATED toLocator16a "Use toEnglish16a instead" #-} + +fromLocator16 :: [Char] -> Int +fromLocator16 = fromEnglish16 +{-# DEPRECATED fromLocator16 "Use fromEnglish16 instead" #-} + + +hashStringToLocator16a :: Int -> ByteString -> ByteString +hashStringToLocator16a = hashStringToEnglish16a +{-# DEPRECATED hashStringToLocator16a "Use hashStringToEnglish16a instead" #-} diff --git a/lib/Data/Locator/Latin25.hs b/lib/Data/Locator/Latin25.hs new file mode 100644 --- /dev/null +++ b/lib/Data/Locator/Latin25.hs @@ -0,0 +1,186 @@ +-- +-- Human exchangable identifiers and locators +-- +-- Copyright © 2011-2018 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 #-} +{-# LANGUAGE InstanceSigs #-} + +module Data.Locator.Latin25 + ( Latin25(..) + , toLatin25 + , fromLatin25 + , hashStringToLatin25 + ) where + +import Prelude hiding (toInteger) + +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as S +import Numeric (showIntAtBase) + +import Data.Locator.Common +import Data.Locator.Hashes (padWithZeros) + +-- +-- | A symbol set with twenty-five visually distinct characters. +-- +-- These are not protected against similar pronounciations; if you need to +-- read your identifiers /aloud/ use 'English16' instead. +-- +{- + + -- | Two -- Obvious conflict with Z + -- | Five -- Obvious conflict with S + -- | Six -- Too close to G + -- | Bravo -- Too close to 8 + -- | Delta -- Shape of D too close to O + -- | Foxtrot -- A bit close to E, and since we've included S, skip + -- | India -- Too close to 1 and J + -- | Oscar -- Obvious conflict with 0 + -- | Quebec -- The tail on Q is too easy to miss, thereby colliding with O/0 + -- | Romeo -- Dropped in favour of P + -- | Uniform -- Too close to V + +-} +data Latin25 + = Zero' -- ^ @\'0\'@ /0th/ + | One' -- ^ @\'1\'@ /1st/ + | Three' -- ^ @\'3\'@ /2nd/ + | Four' -- ^ @\'4\'@ /3rd/ + | Seven' -- ^ @\'7\'@ /4th/ + | Eight' -- ^ @\'8\'@ /5th/ + | Nine' -- ^ @\'9\'@ /6th/ + | Alpha' -- ^ @\'A\'@ /7th/ + | Charlie' -- ^ @\'C\'@ /8th/ + | Echo' -- ^ @\'E\'@ /9th/ + | Golf' -- ^ @\'G\'@ /10th/ + | Hotel' -- ^ @\'H\'@ /11th/ + | Juliet' -- ^ @\'J\'@ /12th/ + | Kilo' -- ^ @\'K\'@ /13th/ + | Lima' -- ^ @\'L\'@ /14th/ + | Mike' -- ^ @\'M\'@ /15th/ + | November' -- ^ @\'N\'@ /16th/ + | Papa' -- ^ @\'P\'@ /17th/ + | Sierra' -- ^ @\'S\'@ /18th/ + | Tango' -- ^ @\'T\'@ /19th/ + | Victor' -- ^ @\'V\'@ /20th/ + | Whiskey' -- ^ @\'W\'@ /21st/ + | XRay' -- ^ @\'X\'@ /22nd/ + | Yankee' -- ^ @\'Y\'@ /23rd/ + | Zulu' -- ^ @\'Z\'@ /24th/ + deriving (Eq, Ord, Enum, Bounded) + +instance Locator Latin25 where + locatorToDigit x = + case x of + Zero' -> '0' + One' -> '1' + Three' -> '3' + Four' -> '4' + Seven' -> '7' + Eight' -> '8' + Nine' -> '9' + Alpha' -> 'A' + Charlie' -> 'C' + Echo' -> 'E' + Golf' -> 'G' + Hotel' -> 'H' + Juliet' -> 'J' + Kilo' -> 'K' + Lima' -> 'L' + Mike' -> 'M' + November' -> 'N' + Papa' -> 'P' + Sierra' -> 'S' + Tango' -> 'T' + Victor' -> 'V' + Whiskey'-> 'W' + XRay' -> 'X' + Yankee' -> 'Y' + Zulu' -> 'Z' + + digitToLocator :: Char -> Latin25 + digitToLocator c = + case c of + '0' -> Zero' + '1' -> One' + '3' -> Three' + '4' -> Four' + '7' -> Seven' + '8' -> Eight' + '9' -> Nine' + 'A' -> Alpha' + 'C' -> Charlie' + 'E' -> Echo' + 'G' -> Golf' + 'H' -> Hotel' + 'J' -> Juliet' + 'K' -> Kilo' + 'L' -> Lima' + 'M' -> Mike' + 'N' -> November' + 'P' -> Papa' + 'S' -> Sierra' + 'T' -> Tango' + 'W' -> Whiskey' + 'V' -> Victor' + 'X' -> XRay' + 'Y' -> Yankee' + 'Z' -> Zulu' + _ -> error "Illegal digit" + + +instance Show Latin25 where + show x = [c] + where + c = locatorToDigit x + +-- +-- | Given a number, convert it to a string in the Latin25 base 25 symbol +-- alphabet. This is useful for primary keys and object identifiers that you +-- need to scan for in log output, for example. +-- +toLatin25 :: Int -> String +toLatin25 x = + showIntAtBase 25 (represent Zulu') x "" + +-- +-- | Given a number encoded in Locator16, convert it back to an integer. +-- +fromLatin25 :: String -> Int +fromLatin25 ss = + foldl (multiply Zulu') 0 ss + +-- +-- | Take an arbitrary sequence of bytes, hash it with SHA1, then format as a +-- short @limit@-long Latin25 string. +-- +-- >>> hashStringToLatin25 5 "You'll get used to it. Or, you'll have a psychotic episode" +-- XSAV1 +-- +-- 17 characters is the widest hash you can request. +-- +hashStringToLatin25 :: Int -> ByteString -> ByteString +hashStringToLatin25 limit s' + | limit > 17 = error "Can only request a maximum width of 17, sorry" + | otherwise = + let + s = S.unpack s' + n = digest s -- SHA1 hash + r = mod n upperBound -- trim to specified number of base 25 chars + x = toLatin25 r -- express in Latin25 + b' = S.pack (padWithZeros limit x) + in + b' + where + upperBound = 25 ^ limit diff --git a/lib/Data/Locator/Locators.hs b/lib/Data/Locator/Locators.hs deleted file mode 100644 --- a/lib/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/locators.cabal b/locators.cabal --- a/locators.cabal +++ b/locators.cabal @@ -1,9 +1,9 @@ cabal-version: 1.24 name: locators -version: 0.2.4.4 +version: 0.3.0.2 synopsis: Human exchangable identifiers and locators -license: BSD3 -license-file: LICENCE +license: MIT +license-file: LICENSE description: /Overview/ . @@ -11,11 +11,11 @@ systems) using a subset of the Latin1 alphabet whose characters are unambigious when written or spoken. -author: Andrew Cowie -maintainer: Andrew Cowie -copyright: © 2013-2018 Operational Dynamics Consulting, Pty Ltd and Others +author: Andrew Cowie +maintainer: Andrew Cowie +copyright: © 2013-2020 Athae Eredh Siniath and Others category: Other -tested-with: GHC == 8.2.2, GHC == 8.4.2 +tested-with: GHC == 8.8.3 stability: experimental build-type: Simple @@ -32,8 +32,10 @@ include-dirs: . exposed-modules: Data.Locator - other-modules: Data.Locator.Hashes, - Data.Locator.Locators + other-modules: Data.Locator.Common, + Data.Locator.Hashes, + Data.Locator.English16 + Data.Locator.Latin25 ghc-options: -Wall @@ -77,7 +79,7 @@ source-repository head type: git - location: git@github.com:afcowie/locators.git + location: git@github.com:aesiniath/locators.git -- vim: set tabstop=21 expandtab: diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs --- a/tests/TestSuite.hs +++ b/tests/TestSuite.hs @@ -1,7 +1,7 @@ -- -- Human exchangable identifiers and locators -- --- Copyright © 2013-2017 Operational Dynamics Consulting, Pty Ltd +-- Copyright © 2013-2018 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: @@ -17,13 +17,13 @@ module TestSuite where +import Control.Exception (evaluate) import Test.Hspec import Test.Hspec.QuickCheck import Test.HUnit import Test.QuickCheck (elements, property) import Test.QuickCheck.Arbitrary (Arbitrary, arbitrary) - -- -- Otherwise redundent imports, but useful for testing in GHCi. -- @@ -42,24 +42,31 @@ suite :: Spec suite = do - describe "Locators" $ do - testRoundTripLocator16 - testKnownLocator16a + describe "Locators (English16)" $ do + testRoundTripEnglish16 + testKnownEnglish16a testProblematicEdgeCases testNegativeNumbers + testWidthGuardsEnglish16a + describe "Locators (Latin25)" $ do + testKnownLatin25 + testRoundTripLatin25 + testHashLatin25 + testWidthGuardsHashing + describe "Hashes" $ do testPaddingRefactored -testRoundTripLocator16 = - prop "safe conversion to/from Locator16" prop_Locator16 +testRoundTripEnglish16 = + prop "safe conversion to/from English16" prop_English16 -prop_Locator16 :: Int -> Bool -prop_Locator16 i = +prop_English16 :: Int -> Bool +prop_English16 i = let n = abs i - decoded = fromLocator16 (toLocator16 n) + decoded = fromEnglish16 (toEnglish16 n) in n == decoded @@ -67,17 +74,17 @@ -- -- Have to do these manually, since Locator16a is not round-trip safe. -- -testKnownLocator16a = - it "constrains Locator16a to unique digits" $ do - toLocator16a 6 0x111111 `shouldBe` "12C4FH" - toLocator16a 6 0x777777 `shouldBe` "789KLM" - toLocator16a 6 0xCCCCCC `shouldBe` "MRXY01" +testKnownEnglish16a = + it "constrains English16a to unique digits" $ do + toEnglish16a 6 0x111111 `shouldBe` "12C4FH" + toEnglish16a 6 0x777777 `shouldBe` "789KLM" + toEnglish16a 6 0xCCCCCC `shouldBe` "MRXY01" testProblematicEdgeCases = it "converstion to Locator16a correct on corner cases" $ do - toLocator16a 6 0x0 `shouldBe` "012C4F" - hashStringToLocator16a 6 "perf_data" `shouldBe` "FHL417" - hashStringToLocator16a 6 "perf_data/bletchley" `shouldBe` "K48F01" + toEnglish16a 6 0x0 `shouldBe` "012C4F" + hashStringToEnglish16a 6 "perf_data" `shouldBe` "FHL417" + hashStringToEnglish16a 6 "perf_data/bletchley" `shouldBe` "K48F01" testPaddingRefactored = it "correctly pads strings" $ do @@ -88,4 +95,37 @@ testNegativeNumbers = it "doesn't explode if fed a negative number" $ do - toLocator16a 1 (-1) `shouldBe` "1" + toEnglish16a 1 (-1) `shouldBe` "1" + +testKnownLatin25 = + it "base 25 is correct" $ do + toLatin25 0 `shouldBe` "0" + toLatin25 1 `shouldBe` "1" + toLatin25 24 `shouldBe` "Z" + toLatin25 25 `shouldBe` "10" + +testRoundTripLatin25 = + prop "safe conversion to/from Latin25" prop_English16 + +prop_Latin25 :: Int -> Bool +prop_Latin25 i = + let + n = abs i + encoded = toLatin25 n + decoded = fromLatin25 encoded + in + n == decoded + +testHashLatin25 = + it "hashToLatin25 generates an appropriate hash" $ do + hashStringToLatin25 5 "You'll get used to it. Or, you'll have a psychotic episode" + `shouldBe` "XSAV1" + +testWidthGuardsEnglish16a = + it "errors if asking for more than 16 English16a characters" $ do + evaluate (toEnglish16a 17 1) `shouldThrow` anyErrorCall + +testWidthGuardsHashing = + it "errors if asking for more than 17 hash digits" $ do + S.length (hashStringToLatin25 17 "a") `shouldBe` 17 + evaluate (hashStringToLatin25 18 "a") `shouldThrow` anyErrorCall diff --git a/tests/check.hs b/tests/check.hs --- a/tests/check.hs +++ b/tests/check.hs @@ -1,7 +1,7 @@ -- -- Human exchangable identifiers and locators -- --- Copyright © 2013-2017 Operational Dynamics Consulting, Pty Ltd +-- Copyright © 2013-2018 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: @@ -18,3 +18,4 @@ main :: IO () main = do hspec suite + putStrLn "Ok"