{-# LANGUAGE OverloadedStrings #-} module Crypto.PubKey.OpenSsh.Decode where import Prelude hiding (take) import Control.Applicative ((*>), (<|>)) import Control.Monad (void, replicateM) import Data.ByteString.Char8 (ByteString) import Data.Char (isControl) import Data.Attoparsec.ByteString.Char8 (Parser, parseOnly, take, space, isSpace, takeTill) import Data.Serialize (Get, getBytes, runGet, getWord32be, getWord8) import qualified Data.ByteString.Base64 as Base64 import qualified Crypto.Types.PubKey.DSA as DSA import qualified Crypto.Types.PubKey.RSA as RSA import Crypto.PubKey.OpenSsh.Types (OpenSshPublicKeyType(..), OpenSshPublicKey(..)) typeSize :: Int typeSize = 7 readType :: Monad m => ByteString -> m OpenSshPublicKeyType readType "ssh-rsa" = return OpenSshPublicKeyTypeRsa readType "ssh-dss" = return OpenSshPublicKeyTypeDsa readType _ = fail "Invalid key type" calculateSize :: Integer -> Int calculateSize = go 1 where go i n | 2 ^ (i * 8) > n = i | otherwise = go (i + 1) n getInteger :: Get Integer getInteger = do size <- fmap fromIntegral getWord32be ints <- fmap reverse $ replicateM size $ fmap toInteger getWord8 return $ fst $ flip foldl1 (zip ints ([0..] :: [Integer])) $ \(a, _) (c, p) -> (c * (256 ^ p) + a, p) getOpenSshPublicKey :: Get (ByteString -> OpenSshPublicKey) getOpenSshPublicKey = do size <- fmap fromIntegral $ getWord32be getBytes size >>= readType >>= \typ -> case typ of OpenSshPublicKeyTypeRsa -> parseRsa OpenSshPublicKeyTypeDsa -> parseDsa where parseRsa = do e <- getInteger n <- getInteger return $ OpenSshPublicKeyRsa $ RSA.PublicKey (calculateSize n) n e parseDsa = do p <- getInteger q <- getInteger g <- getInteger y <- getInteger return $ OpenSshPublicKeyDsa $ DSA.PublicKey (p, g, q) y openSshPublicKeyParser :: Parser OpenSshPublicKey openSshPublicKeyParser = do void $ readType =<< take typeSize void space b64 <- takeTill isSpace binary <- either fail return $ Base64.decode b64 partialKey <- either fail return $ runGet getOpenSshPublicKey binary fmap partialKey commentParser where commentParser = void space *> (takeTill $ \c -> isSpace c || isControl c) <|> return "" decode :: ByteString -> Either String OpenSshPublicKey decode = parseOnly openSshPublicKeyParser