1{- authentication tokens
2 -
3 - Copyright 2016 Joey Hess <id@joeyh.name>
4 -
5 - License: BSD-2-clause
6 -}
7
8module Utility.AuthToken (
9	AuthToken,
10	toAuthToken,
11	fromAuthToken,
12	nullAuthToken,
13	genAuthToken,
14	AllowedAuthTokens,
15	allowedAuthTokens,
16	isAllowedAuthToken,
17) where
18
19import qualified Utility.SimpleProtocol as Proto
20import Utility.Hash
21
22import Data.SecureMem
23import Data.Maybe
24import Data.Char
25import Data.Byteable
26import qualified Data.Text as T
27import qualified Data.Text.Encoding as TE
28import qualified Data.ByteString.Lazy as L
29import "crypto-api" Crypto.Random
30
31-- | An AuthToken is stored in secure memory, with constant time comparison.
32--
33-- It can have varying length, depending on the security needs of the
34-- application.
35--
36-- To avoid decoding issues, and presentation issues, the content
37-- of an AuthToken is limited to ASCII characters a-z, and 0-9.
38-- This is enforced by all exported AuthToken constructors.
39newtype AuthToken = AuthToken SecureMem
40	deriving (Show, Eq)
41
42allowedChar :: Char -> Bool
43allowedChar c = isAsciiUpper c || isAsciiLower c || isDigit c
44
45instance Proto.Serializable AuthToken where
46	serialize = T.unpack . fromAuthToken
47	deserialize = toAuthToken . T.pack
48
49fromAuthToken :: AuthToken -> T.Text
50fromAuthToken (AuthToken t ) = TE.decodeLatin1 (toBytes t)
51
52-- | Upper-case characters are lower-cased to make them fit in the allowed
53-- character set. This allows AuthTokens to be compared effectively
54-- case-insensitively.
55--
56-- Returns Nothing if any disallowed characters are present.
57toAuthToken :: T.Text -> Maybe AuthToken
58toAuthToken t
59	| all allowedChar s = Just $ AuthToken $
60		secureMemFromByteString $ TE.encodeUtf8 $ T.pack s
61	| otherwise = Nothing
62  where
63	s = map toLower $ T.unpack t
64
65-- | The empty AuthToken, for those times when you don't want any security.
66nullAuthToken :: AuthToken
67nullAuthToken = AuthToken $ secureMemFromByteString $ TE.encodeUtf8 T.empty
68
69-- | Generates an AuthToken of a specified length. This is done by
70-- generating a random bytestring, hashing it with sha2 512, and truncating
71-- to the specified length.
72--
73-- That limits the maximum length to 128, but with 512 bytes of entropy,
74-- that should be sufficient for any application.
75genAuthToken :: Int -> IO AuthToken
76genAuthToken len = do
77	g <- newGenIO :: IO SystemRandom
78	return $
79		case genBytes 512 g of
80			Left e -> error $ "failed to generate auth token: " ++ show e
81			Right (s, _) -> fromMaybe (error "auth token encoding failed") $
82				toAuthToken $ T.pack $ take len $
83					show $ sha2_512 $ L.fromChunks [s]
84
85-- | For when several AuthTokens are allowed to be used.
86newtype AllowedAuthTokens = AllowedAuthTokens [AuthToken]
87
88allowedAuthTokens :: [AuthToken] -> AllowedAuthTokens
89allowedAuthTokens = AllowedAuthTokens
90
91-- | Note that every item in the list is checked, even if the first one
92-- is allowed, so that comparison is constant-time.
93isAllowedAuthToken :: AuthToken -> AllowedAuthTokens -> Bool
94isAllowedAuthToken t (AllowedAuthTokens l) = go False l
95  where
96	go ok [] = ok
97	go ok (i:is)
98		| t == i = go True is
99		| otherwise = go ok is
100