952664641a
This makes it easier to build eg benchmarks of individual modules. May be that most of these PackageImports are not really necessary, dunno.
101 lines
3.1 KiB
Haskell
101 lines
3.1 KiB
Haskell
{- authentication tokens
|
|
-
|
|
- Copyright 2016 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE PackageImports #-}
|
|
|
|
module Utility.AuthToken (
|
|
AuthToken,
|
|
toAuthToken,
|
|
fromAuthToken,
|
|
nullAuthToken,
|
|
genAuthToken,
|
|
AllowedAuthTokens,
|
|
allowedAuthTokens,
|
|
isAllowedAuthToken,
|
|
) where
|
|
|
|
import qualified Utility.SimpleProtocol as Proto
|
|
import Utility.Hash
|
|
|
|
import Data.SecureMem
|
|
import Data.Maybe
|
|
import Data.Char
|
|
import Data.Byteable
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as TE
|
|
import qualified Data.ByteString.Lazy as L
|
|
import "crypto-api" Crypto.Random
|
|
|
|
-- | An AuthToken is stored in secure memory, with constant time comparison.
|
|
--
|
|
-- It can have varying length, depending on the security needs of the
|
|
-- application.
|
|
--
|
|
-- To avoid decoding issues, and presentation issues, the content
|
|
-- of an AuthToken is limited to ASCII characters a-z, and 0-9.
|
|
-- This is enforced by all exported AuthToken constructors.
|
|
newtype AuthToken = AuthToken SecureMem
|
|
deriving (Show, Eq)
|
|
|
|
allowedChar :: Char -> Bool
|
|
allowedChar c = isAsciiUpper c || isAsciiLower c || isDigit c
|
|
|
|
instance Proto.Serializable AuthToken where
|
|
serialize = T.unpack . fromAuthToken
|
|
deserialize = toAuthToken . T.pack
|
|
|
|
fromAuthToken :: AuthToken -> T.Text
|
|
fromAuthToken (AuthToken t ) = TE.decodeLatin1 (toBytes t)
|
|
|
|
-- | Upper-case characters are lower-cased to make them fit in the allowed
|
|
-- character set. This allows AuthTokens to be compared effectively
|
|
-- case-insensitively.
|
|
--
|
|
-- Returns Nothing if any disallowed characters are present.
|
|
toAuthToken :: T.Text -> Maybe AuthToken
|
|
toAuthToken t
|
|
| all allowedChar s = Just $ AuthToken $
|
|
secureMemFromByteString $ TE.encodeUtf8 $ T.pack s
|
|
| otherwise = Nothing
|
|
where
|
|
s = map toLower $ T.unpack t
|
|
|
|
-- | The empty AuthToken, for those times when you don't want any security.
|
|
nullAuthToken :: AuthToken
|
|
nullAuthToken = AuthToken $ secureMemFromByteString $ TE.encodeUtf8 T.empty
|
|
|
|
-- | Generates an AuthToken of a specified length. This is done by
|
|
-- generating a random bytestring, hashing it with sha2 512, and truncating
|
|
-- to the specified length.
|
|
--
|
|
-- That limits the maximum length to 128, but with 512 bytes of entropy,
|
|
-- that should be sufficient for any application.
|
|
genAuthToken :: Int -> IO AuthToken
|
|
genAuthToken len = do
|
|
g <- newGenIO :: IO SystemRandom
|
|
return $
|
|
case genBytes 512 g of
|
|
Left e -> error $ "failed to generate auth token: " ++ show e
|
|
Right (s, _) -> fromMaybe (error "auth token encoding failed") $
|
|
toAuthToken $ T.pack $ take len $
|
|
show $ sha2_512 $ L.fromChunks [s]
|
|
|
|
-- | For when several AuthTokens are allowed to be used.
|
|
newtype AllowedAuthTokens = AllowedAuthTokens [AuthToken]
|
|
|
|
allowedAuthTokens :: [AuthToken] -> AllowedAuthTokens
|
|
allowedAuthTokens = AllowedAuthTokens
|
|
|
|
-- | Note that every item in the list is checked, even if the first one
|
|
-- is allowed, so that comparison is constant-time.
|
|
isAllowedAuthToken :: AuthToken -> AllowedAuthTokens -> Bool
|
|
isAllowedAuthToken t (AllowedAuthTokens l) = go False l
|
|
where
|
|
go ok [] = ok
|
|
go ok (i:is)
|
|
| t == i = go True is
|
|
| otherwise = go ok is
|