{- DisTract ------------------------------------------------------\
 |                                                                 |
 | Copyright (c) 2007, Matthew Sackman (matthew@wellquite.org)     |
 |                                                                 |
 | DisTract is freely distributable under the terms of a 3-Clause  |
 | BSD-style license. For details, see the DisTract web site:      |
 |   http://distract.wellquite.org/                                |
 |                                                                 |
 \-----------------------------------------------------------------}

module DisTract.Monotone.Types
    (Key(..),
     Hash(..),
     Cert(..),
     Trust(..),
     Signature(..),
     Revision(..),
     LogBrief(..)
    )
where

import Data.Word
import Data.Time
import Numeric
import System.Locale
import DisTract.Utils

data Key = PublicKey String Hash
         | PrivateKey String Hash
           deriving (Eq, Show)

-- 64 bits is 8 bytes, 8 * 5 = 40 == sha1sum size
data Hash = Hash Word64 Word64 Word64 Word64 Word64
            deriving (Eq)

instance Show Hash where
    show (Hash w1 w2 w3 w4 w5) = foldr showHexPad "" [w1,w2,w3,w4,w5]
        where
          showHexPad :: Word64 -> String -> String
          showHexPad w s = padding ++ simple
              where
                simple = showHex w s
                padding = replicate count '0'
                count = (8 - (findCols 0 w)) `mod` 8
                -- use this rather than length as it
                -- avoids eval-ing the whole string
                -- (using (length simple `mod` 8)
                -- would make the show O((n^2) /2) )
                findCols :: Int -> Word64 -> Int
                findCols c 0 = c
                findCols c n = findCols (c+1) (n `div` 16)

data Revision = Revision Hash [Cert]
            deriving (Eq, Show)
data Cert = Cert { certName :: String,
                   certValue ::  String,
                   certKey :: String,
                   certTrust :: Trust,
                   certSignature :: Signature
                 }
            deriving (Eq, Show)
data Trust = Trusted | Untrusted
            deriving (Eq, Show)
data Signature = SigOk | SigBad | SigUnknown
            deriving (Eq, Show)

data LogBrief = LogBrief { logRevisionHash :: Hash,
                           logRevisionAuthor :: String,
                           logRevisionTime :: UTCTime,
                           logRevisionBranch :: String
                         }

instance Show LogBrief where
    show (LogBrief hash author time branch)
             = "LogBrief: Revision " ++ (show hash) ++
               " at " ++ timeFormatted ++ " by " ++ author ++
               " on branch " ++ branch
        where
          timeFormatted = formatTime defaultTimeLocale
                          monotoneDateFormat time