{-# LANGUAGE OverloadedStrings #-}
module SSHKey where

import qualified Data.ByteString.Lazy.Char8 as L8
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Char8 as S8
import Data.ByteArray.Encoding
import FunctorToMaybe
import Data.Binary.Get ( runGet )
import Data.Binary.Put ( putWord32be, runPut, putByteString )
import Data.Binary     ( get, put )
import Data.Monoid     ( (<>) )
import Data.Maybe      ( listToMaybe )
import Data.Char       ( isSpace )
import Control.Monad   ( guard )
import LengthPrefixedBE

type Key = (Integer,Integer)


sshrsa :: Integer -> Integer -> L.ByteString
sshrsa e n = runPut $ do
    putWord32be 7
    putByteString "ssh-rsa"
    put (LengthPrefixedBE e)
    put (LengthPrefixedBE n)

keyblob :: Key -> L.ByteString
keyblob (n,e) = "ssh-rsa " <> blob
 where
    bs = sshrsa e n
    blob = L.fromStrict $ convertToBase Base64 (L.toStrict bs)

blobkey :: L8.ByteString -> Maybe Key
blobkey bs = do
    let (pre,bs1) = L8.splitAt 7 bs
    guard $ pre == "ssh-rsa"
    let (sp,bs2) = L8.span isSpace bs1
    guard $ not (L8.null sp)
    bs3 <- listToMaybe $ L8.words bs2
    qq <- fmap L.fromStrict $ functorToMaybe $ convertFromBase Base64 $ L.toStrict bs3
    decode_sshrsa qq
 where
    decode_sshrsa :: L8.ByteString -> Maybe Key
    decode_sshrsa bs = do
        let (pre,bs1) = L8.splitAt 11 bs
        guard $ pre == runPut (putWord32be 7 >> putByteString "ssh-rsa")
        let rsakey = flip runGet bs1 $ do
                LengthPrefixedBE e <- get
                LengthPrefixedBE n <- get
                return (n,e)
        return rsakey