summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-04-21 22:02:12 -0400
committerjoe <joe@jerkface.net>2014-04-21 22:02:12 -0400
commita3dae3710e1d7578301b0abbb1a0fd9db4476f7e (patch)
treef9021003e1db9b064affcc190eedfc6946501bab
parentfc7b107a2c0c2a80cec5015e7de8394cc88746e5 (diff)
more type sigs in KeyRing.hs (I reached the end of the file now)
-rw-r--r--KeyRing.hs32
1 files changed, 31 insertions, 1 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 3897ef5..10baa98 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -893,7 +893,7 @@ buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet))
893 ([Hosts.Hosts], 893 ([Hosts.Hosts],
894 [Hosts.Hosts], 894 [Hosts.Hosts],
895 Hosts.Hosts, 895 Hosts.Hosts,
896 [(SockAddr, ([ByteString], [ByteString]))], 896 [(SockAddr, (KeyKey, KeyKey))],
897 [SockAddr]) ) 897 [SockAddr]) )
898 ,[(FilePath,KikiReportAction)])) 898 ,[(FilePath,KikiReportAction)]))
899buildKeyDB doDecrypt secring pubring grip0 keyring = do 899buildKeyDB doDecrypt secring pubring grip0 keyring = do
@@ -1735,6 +1735,7 @@ sigpackets typ hashed unhashed = return $
1735 0 -- Word16 -- Left 16 bits of the signed hash value 1735 0 -- Word16 -- Left 16 bits of the signed hash value
1736 [] -- [MPI] 1736 [] -- [MPI]
1737 1737
1738secretToPublic :: Packet -> Packet
1738secretToPublic pkt@(SecretKeyPacket {}) = 1739secretToPublic pkt@(SecretKeyPacket {}) =
1739 PublicKeyPacket { version = version pkt 1740 PublicKeyPacket { version = version pkt
1740 , timestamp = timestamp pkt 1741 , timestamp = timestamp pkt
@@ -1763,6 +1764,8 @@ slurpWIPKeys stamp cs =
1763 in maybe (ks,b58:js) (\(net,Message [k])->((net,k):ks,js)) mb 1764 in maybe (ks,b58:js) (\(net,Message [k])->((net,k):ks,js)) mb
1764 1765
1765 1766
1767decode_btc_key ::
1768 Enum timestamp => timestamp -> String -> Maybe (Word8, Message)
1766decode_btc_key timestamp str = do 1769decode_btc_key timestamp str = do
1767 (network_id,us) <- base58_decode str 1770 (network_id,us) <- base58_decode str
1768 return . (network_id,) $ Message $ do 1771 return . (network_id,) $ Message $ do
@@ -1853,8 +1856,10 @@ readPacketsFromFile fname = do
1853 return $ decode input 1856 return $ decode input
1854#endif 1857#endif
1855 1858
1859now :: IO Integer
1856now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime 1860now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime
1857 1861
1862signature_time :: SignatureOver -> Word32
1858signature_time ov = case if null cs then ds else cs of 1863signature_time ov = case if null cs then ds else cs of
1859 [] -> minBound 1864 [] -> minBound
1860 xs -> last (sort xs) 1865 xs -> last (sort xs)
@@ -1866,6 +1871,7 @@ signature_time ov = case if null cs then ds else cs of
1866 creationTime (SignatureCreationTimePacket t) = [t] 1871 creationTime (SignatureCreationTimePacket t) = [t]
1867 creationTime _ = [] 1872 creationTime _ = []
1868 1873
1874splitAtMinBy :: (t -> t -> Ordering) -> [t] -> ([t], [t])
1869splitAtMinBy comp xs = minimumBy comp' xxs 1875splitAtMinBy comp xs = minimumBy comp' xxs
1870 where 1876 where
1871 xxs = zip (inits xs) (tails xs) 1877 xxs = zip (inits xs) (tails xs)
@@ -1876,6 +1882,14 @@ splitAtMinBy comp xs = minimumBy comp' xxs
1876 1882
1877 1883
1878 1884
1885findTag ::
1886 String
1887 -> Packet
1888 -> Packet
1889 -> [(MappedPacket, b)]
1890 -> ([(MappedPacket, b)],
1891 Maybe (Bool, (MappedPacket, b)),
1892 [(MappedPacket, b)])
1879findTag tag wk subkey subsigs = (xs',minsig,ys') 1893findTag tag wk subkey subsigs = (xs',minsig,ys')
1880 where 1894 where
1881 vs = map (\sig -> 1895 vs = map (\sig ->
@@ -1905,6 +1919,14 @@ findTag tag wk subkey subsigs = (xs',minsig,ys')
1905 return (tag `elem` ks, sig) 1919 return (tag `elem` ks, sig)
1906 1920
1907 1921
1922makeSig ::
1923 (MappedPacket -> IO (KikiCondition Packet))
1924 -> MappedPacket
1925 -> [Char]
1926 -> MappedPacket
1927 -> [Char]
1928 -> Maybe (MappedPacket, Map.Map k a)
1929 -> IO (KikiCondition ((MappedPacket, Map.Map k a), [KikiReportAction]))
1908makeSig doDecrypt top fname subkey_p tag mbsig = do 1930makeSig doDecrypt top fname subkey_p tag mbsig = do
1909 let wk = packet top 1931 let wk = packet top
1910 wkun <- doDecrypt top 1932 wkun <- doDecrypt top
@@ -2036,18 +2058,21 @@ origin p n = OriginFlags ispub n
2036 SecretKeyPacket {} -> False 2058 SecretKeyPacket {} -> False
2037 _ -> True 2059 _ -> True
2038 2060
2061mappedPacket :: FilePath -> Packet -> MappedPacket
2039mappedPacket filename p = MappedPacket 2062mappedPacket filename p = MappedPacket
2040 { packet = p 2063 { packet = p
2041 , usage_tag = Nothing 2064 , usage_tag = Nothing
2042 , locations = Map.singleton filename (origin p (-1)) 2065 , locations = Map.singleton filename (origin p (-1))
2043 } 2066 }
2044 2067
2068keykey :: Packet -> KeyKey
2045keykey key = 2069keykey key =
2046 -- Note: The key's timestamp is included in it's fingerprint. 2070 -- Note: The key's timestamp is included in it's fingerprint.
2047 -- Therefore, the same key with a different timestamp is 2071 -- Therefore, the same key with a different timestamp is
2048 -- considered distinct using this keykey implementation. 2072 -- considered distinct using this keykey implementation.
2049 fingerprint_material (key {timestamp=0}) -- TODO: smaller key? 2073 fingerprint_material (key {timestamp=0}) -- TODO: smaller key?
2050 2074
2075uidkey :: Packet -> String
2051uidkey (UserIDPacket str) = str 2076uidkey (UserIDPacket str) = str
2052 2077
2053merge :: KeyDB -> FilePath -> Message -> KeyDB 2078merge :: KeyDB -> FilePath -> Message -> KeyDB
@@ -2207,8 +2232,11 @@ unsig fname isPublic (sig,trustmap) =
2207 asMapped n p = let m = mappedPacket fname p 2232 asMapped n p = let m = mappedPacket fname p
2208 in m { locations = fmap (\x->x {originalNum=n}) (locations m) } 2233 in m { locations = fmap (\x->x {originalNum=n}) (locations m) }
2209 2234
2235concatSort ::
2236 FilePath -> ([a] -> MappedPacket) -> (b -> [a]) -> [b] -> [a]
2210concatSort fname getp f = concat . sortByHint fname getp . map f 2237concatSort fname getp f = concat . sortByHint fname getp . map f
2211 2238
2239sortByHint :: FilePath -> (a -> MappedPacket) -> [a] -> [a]
2212sortByHint fname f = sortBy (comparing gethint) 2240sortByHint fname f = sortBy (comparing gethint)
2213 where 2241 where
2214 gethint = maybe defnum originalNum . Map.lookup fname . locations . f 2242 gethint = maybe defnum originalNum . Map.lookup fname . locations . f
@@ -2369,9 +2397,11 @@ fingerdress topk = maybe zero id $ Hosts.inet_pton addr_str
2369 colons (a:b:c:d:xs@(_:_)) = [a,b,c,d,':'] ++ colons xs 2397 colons (a:b:c:d:xs@(_:_)) = [a,b,c,d,':'] ++ colons xs
2370 colons xs = xs 2398 colons xs = xs
2371 2399
2400backsig :: SignatureSubpacket -> Maybe Packet
2372backsig (EmbeddedSignaturePacket s) = Just s 2401backsig (EmbeddedSignaturePacket s) = Just s
2373backsig _ = Nothing 2402backsig _ = Nothing
2374 2403
2404socketFamily :: SockAddr -> Family
2375socketFamily (SockAddrInet _ _) = AF_INET 2405socketFamily (SockAddrInet _ _) = AF_INET
2376socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6 2406socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6
2377socketFamily (SockAddrUnix _) = AF_UNIX 2407socketFamily (SockAddrUnix _) = AF_UNIX