{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
-- |Data formats for directory cert information.
module Tor.DataFormat.DirCertInfo(
         DirectoryCertInfo(..)
       , parseDirectoryCertInfo
       )
 where

import Control.Monad
import Crypto.Hash.Easy
import Crypto.PubKey.RSA
import Crypto.PubKey.RSA.PKCS15
import Data.Attoparsec.ByteString
import Data.ByteString(ByteString)
import qualified Data.ByteString as BS
import Data.Hourglass
import Tor.DataFormat.Helpers

-- |Information about a directory cert.
data DirectoryCertInfo = DirectoryCertInfo {
       dcFingerprint      :: ByteString
     , dcPublished        :: DateTime
     , dcExpires          :: DateTime
     , dcIdentityKey      :: PublicKey
     , dcSigningKey       :: PublicKey
     , dcKeyCertification :: ByteString
     }
 deriving (Show)

-- FIXME: Handle partial input
-- |Parse in a DirectoryCertInfo.
parseDirectoryCertInfo :: ByteString -> Either String DirectoryCertInfo
parseDirectoryCertInfo bstr =
  case parse dirCertInfo bstr of
    Fail bstr' _ err -> Left (err ++ "[" ++ show (BS.take 10 bstr') ++ "]")
    Partial _        -> Left "Incomplete Directory cert info."
    Done _       res ->
      if verify noHash (dcIdentityKey res) digest (dcKeyCertification res)
         then Right res
         else Left "RSA verification failed."
 where
  digest = generateHash bstr

generateHash :: ByteString -> ByteString
generateHash infile = sha1 (run infile)
 where
  run bstr =
    case BS.span (/= 10) bstr of
      (start, finale) | "\ndir-key-certification\n" `BS.isPrefixOf` finale ->
        start `BS.append` "\ndir-key-certification\n"
      (start, rest) ->
        start `BS.append` (BS.singleton 10) `BS.append` run (BS.drop 1 rest)

dirCertInfo :: Parser DirectoryCertInfo
dirCertInfo =
  do _                       <- string "dir-key-certificate-version 3\n"
     dcFingerprint           <- standardLine "fingerprint" hexDigest
     dcPublished             <- standardLine "dir-key-published" utcTime
     dcExpires               <- standardLine "dir-key-expires" utcTime
     _                       <- string "dir-identity-key\n"
     (dcIdentityKey, idbstr) <- publicKey'
     _                       <- string "dir-signing-key\n"
     dcSigningKey            <- publicKey
     _                       <- string "dir-key-crosscert\n"
     idsig                   <- signature
     _                       <- string "dir-key-certification\n"
     dcKeyCertification      <- signature
     unless (verify noHash dcSigningKey (sha1 idbstr) idsig) $
       fail "RSA ID key verification failed."
     return DirectoryCertInfo{..}

signature :: Parser ByteString
signature =
  do _ <- string "-----BEGIN "
     _ <- option undefined $ string "ID "
     _ <- string "SIGNATURE-----\n"
     let end = string "-----END "
     bstr <- decodeBase64 =<< manyTill base64Char end
     _ <- option undefined $ string "ID "
     _ <- string "SIGNATURE-----\n"
     return bstr