diff options
author | James Crayne <jim.crayne@gmail.com> | 2014-04-21 23:03:40 -0400 |
---|---|---|
committer | James Crayne <jim.crayne@gmail.com> | 2014-04-21 23:03:40 -0400 |
commit | 673ae2de0f6035ec81df5776dee999295a2eeb00 (patch) | |
tree | f08823da4f76a1db992a3f90e8a6ce987b58ec13 | |
parent | ce4576743a98f225ed9e036ddc8d1eb02ced6dfa (diff) |
Minor cleanup
-rw-r--r-- | HLintIgnores | 9 | ||||
-rw-r--r-- | KeyRing.hs | 87 |
2 files changed, 50 insertions, 46 deletions
diff --git a/HLintIgnores b/HLintIgnores new file mode 100644 index 0000000..473a245 --- /dev/null +++ b/HLintIgnores | |||
@@ -0,0 +1,9 @@ | |||
1 | {-# ANN module ("HLint: ignore Eta reduce"::String) #-} | ||
2 | {-# ANN module ("HLint: ignore Use camelCase"::String) #-} | ||
3 | {-# ANN module ("HLint: ignore Redundant bracket"::String) #-} | ||
4 | {-# ANN module ("HLint: ignore Redundant $"::String) #-} | ||
5 | {-# ANN module ("HLint: ignore Redundant do"::String) #-} | ||
6 | {-# ANN module ("HLint: ignore Use String"::String) #-} | ||
7 | {-# ANN module ("HLint: ignore Use ||"::String) #-} | ||
8 | {-# ANN module ("HLint: ignore Use &&"::String) #-} | ||
9 | {-# ANN module ("HLint: ignore Use ***"::String) #-} | ||
@@ -280,7 +280,7 @@ instance ASN1Object PKCS8_RSAPublicKey where | |||
280 | : End Sequence | 280 | : End Sequence |
281 | : xs | 281 | : xs |
282 | where | 282 | where |
283 | pubkey = Start Sequence : IntVal n : IntVal e : End Sequence : [] | 283 | pubkey = [ Start Sequence, IntVal n, IntVal e, End Sequence ] |
284 | bs = encodeASN1' DER pubkey | 284 | bs = encodeASN1' DER pubkey |
285 | 285 | ||
286 | fromASN1 (Start Sequence:IntVal modulus:IntVal pubexp:End Sequence:xs) = | 286 | fromASN1 (Start Sequence:IntVal modulus:IntVal pubexp:End Sequence:xs) = |
@@ -658,9 +658,9 @@ parseSpec grip spec = (topspec,subspec) | |||
658 | _ | null top && null grip -> KeyUidMatch sub | 658 | _ | null top && null grip -> KeyUidMatch sub |
659 | _ | null top -> KeyGrip grip | 659 | _ | null top -> KeyGrip grip |
660 | _ | toptyp=="fp" || (null toptyp && is40digitHex top) | 660 | _ | toptyp=="fp" || (null toptyp && is40digitHex top) |
661 | -> {- trace "using top" $ -} KeyGrip top | 661 | -> KeyGrip top |
662 | _ | toptyp=="u" -> KeyUidMatch top | 662 | _ | toptyp=="u" -> KeyUidMatch top |
663 | _ | otherwise -> KeyUidMatch top | 663 | _ -> KeyUidMatch top |
664 | subspec = case subtyp of | 664 | subspec = case subtyp of |
665 | "t" -> Just sub | 665 | "t" -> Just sub |
666 | "fp" | top=="" -> Nothing | 666 | "fp" | top=="" -> Nothing |
@@ -721,12 +721,12 @@ seek_key (KeyGrip grip) sec = (pre, subs) | |||
721 | pred p@(PublicKeyPacket {}) = matchpr grip p == grip | 721 | pred p@(PublicKeyPacket {}) = matchpr grip p == grip |
722 | pred _ = False | 722 | pred _ = False |
723 | 723 | ||
724 | seek_key (KeyTag key tag) ps = if null bs | 724 | seek_key (KeyTag key tag) ps |
725 | then (ps,[]) | 725 | | null bs = (ps, []) |
726 | else if null qs | 726 | | null qs = |
727 | then let (as',bs') = seek_key (KeyTag key tag) (tail bs) | 727 | let (as', bs') = seek_key (KeyTag key tag) (tail bs) in |
728 | in (as ++ (head bs:as'), bs') | 728 | (as ++ (head bs : as'), bs') |
729 | else (reverse (tail qs), head qs : reverse rs ++ bs) | 729 | | otherwise = (reverse (tail qs), head qs : reverse rs ++ bs) |
730 | where | 730 | where |
731 | (as,bs) = break (\p -> isSignaturePacket p | 731 | (as,bs) = break (\p -> isSignaturePacket p |
732 | && has_tag tag p | 732 | && has_tag tag p |
@@ -738,15 +738,13 @@ seek_key (KeyTag key tag) ps = if null bs | |||
738 | has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) | 738 | has_tag tag p = tag `elem` mapMaybe usage (hashed_subpackets p) |
739 | || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) | 739 | || tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) |
740 | 740 | ||
741 | seek_key (KeyUidMatch pat) ps = if null bs | 741 | seek_key (KeyUidMatch pat) ps |
742 | then (ps,[]) | 742 | | null bs = (ps, []) |
743 | else if null qs | 743 | | null qs = let (as', bs') = seek_key (KeyUidMatch pat) (tail bs) in |
744 | then let (as',bs') = seek_key (KeyUidMatch pat) (tail bs) | 744 | (as ++ (head bs : as'), bs') |
745 | in (as ++ (head bs:as'), bs') | 745 | | otherwise = (reverse (tail qs), head qs : reverse rs ++ bs) |
746 | else (reverse (tail qs), head qs : reverse rs ++ bs) | ||
747 | where | 746 | where |
748 | (as,bs) = break (isInfixOf pat . uidStr) | 747 | (as,bs) = break (isInfixOf pat . uidStr) ps |
749 | ps | ||
750 | (rs,qs) = break isKey (reverse as) | 748 | (rs,qs) = break isKey (reverse as) |
751 | 749 | ||
752 | uidStr (UserIDPacket s) = s | 750 | uidStr (UserIDPacket s) = s |
@@ -844,7 +842,7 @@ mergeHostFiles krd db secring pubring = do | |||
844 | 842 | ||
845 | -- 2. replace gpg annotations with those in U | 843 | -- 2. replace gpg annotations with those in U |
846 | -- forM use_db | 844 | -- forM use_db |
847 | db' <- Traversable.mapM (setHostnames (\a -> not $ elem a outgoing_names) u1) db | 845 | db' <- Traversable.mapM (setHostnames (`notElem` outgoing_names) u1) db |
848 | 846 | ||
849 | return $ KikiSuccess ((db',(hostdbs0,hostdbs,u1,gpgnames,outgoing_names)),[]) | 847 | return $ KikiSuccess ((db',(hostdbs0,hostdbs,u1,gpgnames,outgoing_names)),[]) |
850 | 848 | ||
@@ -882,7 +880,7 @@ writeHostsFiles krd secring pubring (hostdbs0,hostdbs,u1,gpgnames,outgoing_names | |||
882 | let h = h1 `Hosts.plus` u | 880 | let h = h1 `Hosts.plus` u |
883 | d = Hosts.diff h0 h | 881 | d = Hosts.diff h0 h |
884 | rs = map ((fname,) . HostsDiff) d | 882 | rs = map ((fname,) . HostsDiff) d |
885 | when (not $ null d) $ L.writeFile fname $ Hosts.encode h | 883 | unless (null d) $ L.writeFile fname $ Hosts.encode h |
886 | return rs | 884 | return rs |
887 | return $ concat rss | 885 | return $ concat rss |
888 | 886 | ||
@@ -969,7 +967,7 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do | |||
969 | return $ KikiSuccess ( (db, grip, mwk, hs), reportWallets ++ reportPEMs ) | 967 | return $ KikiSuccess ( (db, grip, mwk, hs), reportWallets ++ reportPEMs ) |
970 | 968 | ||
971 | torhash :: Packet -> String | 969 | torhash :: Packet -> String |
972 | torhash key = maybe "" id $ derToBase32 <$> derRSA key | 970 | torhash key = fromMaybe "" $ derToBase32 <$> derRSA key |
973 | 971 | ||
974 | derToBase32 :: ByteString -> String | 972 | derToBase32 :: ByteString -> String |
975 | derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy | 973 | derToBase32 = map toLower . Base32.encode . S.unpack . SHA1.hashlazy |
@@ -1166,7 +1164,7 @@ coinKeysOwnedBy db wk = do | |||
1166 | (subkk,SubKey mp sigs) <- Map.toList subs | 1164 | (subkk,SubKey mp sigs) <- Map.toList subs |
1167 | let sub = packet mp | 1165 | let sub = packet mp |
1168 | guard $ isCryptoCoinKey sub | 1166 | guard $ isCryptoCoinKey sub |
1169 | tag <- take 1 $ mapMaybe getCryptoCoinTag (map (packet . fst) sigs) | 1167 | tag <- take 1 $ mapMaybe (getCryptoCoinTag . packet . fst) sigs |
1170 | return (tag,mp) | 1168 | return (tag,mp) |
1171 | 1169 | ||
1172 | walletImportFormat :: Word8 -> Packet -> String | 1170 | walletImportFormat :: Word8 -> Packet -> String |
@@ -1432,14 +1430,14 @@ makeMemoizingDecrypter operation secring pubring = do | |||
1432 | decryptIt [] = return BadPassphrase | 1430 | decryptIt [] = return BadPassphrase |
1433 | decryptIt (getpw:getpws) = do | 1431 | decryptIt (getpw:getpws) = do |
1434 | pw <- getpw | 1432 | pw <- getpw |
1435 | let wkun = maybe wk id $ decryptSecretKey pw wk | 1433 | let wkun = fromMaybe wk $ decryptSecretKey pw wk |
1436 | case symmetric_algorithm wkun of | 1434 | case symmetric_algorithm wkun of |
1437 | Unencrypted -> do | 1435 | Unencrypted -> do |
1438 | writeIORef unkeysRef (Map.insert kk wkun unkeys) | 1436 | writeIORef unkeysRef (Map.insert kk wkun unkeys) |
1439 | return $ KikiSuccess wkun | 1437 | return $ KikiSuccess wkun |
1440 | _ -> decryptIt getpws | 1438 | _ -> decryptIt getpws |
1441 | 1439 | ||
1442 | getpws = mapMaybe (flip Map.lookup pws) fs | 1440 | getpws = mapMaybe (`Map.lookup` pws) fs |
1443 | 1441 | ||
1444 | case symmetric_algorithm wk of | 1442 | case symmetric_algorithm wk of |
1445 | Unencrypted -> return (KikiSuccess wk) | 1443 | Unencrypted -> return (KikiSuccess wk) |
@@ -1521,7 +1519,7 @@ initializeMissingPEMFiles operation secring pubring grip decrypt db = do | |||
1521 | let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do | 1519 | let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do |
1522 | (fname,(rtyp,ftyp)) <- nonexistents | 1520 | (fname,(rtyp,ftyp)) <- nonexistents |
1523 | guard $ isMutable rtyp | 1521 | guard $ isMutable rtyp |
1524 | (topspec,subspec) <- fmap (parseSpec $ maybe "" id grip) | 1522 | (topspec,subspec) <- fmap (parseSpec $ fromMaybe "" grip) |
1525 | $ getUsage ftyp | 1523 | $ getUsage ftyp |
1526 | -- ms will contain duplicates if a top key has multiple matching | 1524 | -- ms will contain duplicates if a top key has multiple matching |
1527 | -- subkeys. This is intentional. | 1525 | -- subkeys. This is intentional. |
@@ -1552,7 +1550,7 @@ initializeMissingPEMFiles operation secring pubring grip decrypt db = do | |||
1552 | return (fname,subspec,ms,cmd) | 1550 | return (fname,subspec,ms,cmd) |
1553 | rs <- forM cmds $ \tup@(fname,subspec,ms,cmd) -> do | 1551 | rs <- forM cmds $ \tup@(fname,subspec,ms,cmd) -> do |
1554 | e <- systemEnv [ ("file",fname) | 1552 | e <- systemEnv [ ("file",fname) |
1555 | , ("usage",maybe "" id subspec) ] | 1553 | , ("usage",fromMaybe "" subspec) ] |
1556 | cmd | 1554 | cmd |
1557 | case e of | 1555 | case e of |
1558 | ExitFailure num -> return (tup,FailedExternal num) | 1556 | ExitFailure num -> return (tup,FailedExternal num) |
@@ -1754,10 +1752,10 @@ secretToPublic pkt = pkt | |||
1754 | slurpWIPKeys :: Posix.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString]) | 1752 | slurpWIPKeys :: Posix.EpochTime -> L.ByteString -> ( [(Word8,Packet)], [L.ByteString]) |
1755 | slurpWIPKeys stamp "" = ([],[]) | 1753 | slurpWIPKeys stamp "" = ([],[]) |
1756 | slurpWIPKeys stamp cs = | 1754 | slurpWIPKeys stamp cs = |
1757 | let (b58,xs) = Char8.span (\x -> elem x base58chars) cs | 1755 | let (b58,xs) = Char8.span (`elem` base58chars) cs |
1758 | mb = decode_btc_key stamp (Char8.unpack b58) | 1756 | mb = decode_btc_key stamp (Char8.unpack b58) |
1759 | in if L.null b58 | 1757 | in if L.null b58 |
1760 | then let (ys,xs') = Char8.break (\x -> elem x base58chars) cs | 1758 | then let (ys,xs') = Char8.break (`elem` base58chars) cs |
1761 | (ks,js) = slurpWIPKeys stamp xs' | 1759 | (ks,js) = slurpWIPKeys stamp xs' |
1762 | in (ks,ys:js) | 1760 | in (ks,ys:js) |
1763 | else let (ks,js) = slurpWIPKeys stamp xs | 1761 | else let (ks,js) = slurpWIPKeys stamp xs |
@@ -1810,14 +1808,11 @@ decode_btc_key timestamp str = do | |||
1810 | } | 1808 | } |
1811 | 1809 | ||
1812 | rsaKeyFromPacket :: Packet -> Maybe RSAPublicKey | 1810 | rsaKeyFromPacket :: Packet -> Maybe RSAPublicKey |
1813 | rsaKeyFromPacket p@(PublicKeyPacket {}) = do | 1811 | rsaKeyFromPacket p | isKey p = do |
1814 | n <- lookup 'n' $ key p | ||
1815 | e <- lookup 'e' $ key p | ||
1816 | return $ RSAKey n e | ||
1817 | rsaKeyFromPacket p@(SecretKeyPacket {}) = do | ||
1818 | n <- lookup 'n' $ key p | 1812 | n <- lookup 'n' $ key p |
1819 | e <- lookup 'e' $ key p | 1813 | e <- lookup 'e' $ key p |
1820 | return $ RSAKey n e | 1814 | return $ RSAKey n e |
1815 | |||
1821 | rsaKeyFromPacket _ = Nothing | 1816 | rsaKeyFromPacket _ = Nothing |
1822 | 1817 | ||
1823 | 1818 | ||
@@ -1830,7 +1825,7 @@ readPacketsFromWallet wk fname = do | |||
1830 | modificationTime <$> getFileStatus fname | 1825 | modificationTime <$> getFileStatus fname |
1831 | input <- L.readFile fname | 1826 | input <- L.readFile fname |
1832 | let (ks,_) = slurpWIPKeys timestamp input | 1827 | let (ks,_) = slurpWIPKeys timestamp input |
1833 | when (not (null ks)) $ do | 1828 | unless (null ks) $ do |
1834 | -- decrypt wk | 1829 | -- decrypt wk |
1835 | -- create sigs | 1830 | -- create sigs |
1836 | -- return key/sig pairs | 1831 | -- return key/sig pairs |
@@ -1862,7 +1857,7 @@ now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime | |||
1862 | signature_time :: SignatureOver -> Word32 | 1857 | signature_time :: SignatureOver -> Word32 |
1863 | signature_time ov = case if null cs then ds else cs of | 1858 | signature_time ov = case if null cs then ds else cs of |
1864 | [] -> minBound | 1859 | [] -> minBound |
1865 | xs -> last (sort xs) | 1860 | xs -> maximum xs |
1866 | where | 1861 | where |
1867 | ps = signatures_over ov | 1862 | ps = signatures_over ov |
1868 | ss = filter isSignaturePacket ps | 1863 | ss = filter isSignaturePacket ps |
@@ -1898,7 +1893,7 @@ findTag tag wk subkey subsigs = (xs',minsig,ys') | |||
1898 | guard (isSignaturePacket sig) | 1893 | guard (isSignaturePacket sig) |
1899 | guard $ flip isSuffixOf | 1894 | guard $ flip isSuffixOf |
1900 | (fingerprint wk) | 1895 | (fingerprint wk) |
1901 | . maybe "%bad%" id | 1896 | . fromMaybe "%bad%" |
1902 | . signature_issuer | 1897 | . signature_issuer |
1903 | $ sig | 1898 | $ sig |
1904 | listToMaybe $ | 1899 | listToMaybe $ |
@@ -1932,13 +1927,13 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do | |||
1932 | wkun <- doDecrypt top | 1927 | wkun <- doDecrypt top |
1933 | try wkun $ \wkun -> do | 1928 | try wkun $ \wkun -> do |
1934 | let grip = fingerprint wk | 1929 | let grip = fingerprint wk |
1935 | addOrigin new_sig = do | 1930 | addOrigin new_sig = |
1936 | flip (maybe $ return FailedToMakeSignature) | 1931 | flip (maybe $ return FailedToMakeSignature) |
1937 | (new_sig >>= listToMaybe . signatures_over) | 1932 | (new_sig >>= listToMaybe . signatures_over) |
1938 | $ \new_sig -> do | 1933 | $ \new_sig -> do |
1939 | let mp' = mappedPacket fname new_sig | 1934 | let mp' = mappedPacket fname new_sig |
1940 | return $ KikiSuccess (mp', Map.empty) | 1935 | return $ KikiSuccess (mp', Map.empty) |
1941 | parsedkey = [packet $ subkey_p] | 1936 | parsedkey = [packet subkey_p] |
1942 | hashed0 = | 1937 | hashed0 = |
1943 | [ KeyFlagsPacket | 1938 | [ KeyFlagsPacket |
1944 | { certify_keys = False | 1939 | { certify_keys = False |
@@ -1997,7 +1992,7 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do | |||
1997 | map unwrap es where unwrap (SignatureExpirationTimePacket x) = x | 1992 | map unwrap es where unwrap (SignatureExpirationTimePacket x) = x |
1998 | expires = liftA2 (+) stamp exp | 1993 | expires = liftA2 (+) stamp exp |
1999 | timestamp <- now | 1994 | timestamp <- now |
2000 | if fmap ( (< timestamp) . fromIntegral) expires == Just True then do | 1995 | if fmap ( (< timestamp) . fromIntegral) expires == Just True then |
2001 | return $ KikiSuccess ((mp,trustmap), [ UnableToUpdateExpiredSignature ] ) | 1996 | return $ KikiSuccess ((mp,trustmap), [ UnableToUpdateExpiredSignature ] ) |
2002 | else do | 1997 | else do |
2003 | let times = (:) (SignatureExpirationTimePacket (fromIntegral timestamp)) | 1998 | let times = (:) (SignatureExpirationTimePacket (fromIntegral timestamp)) |
@@ -2091,7 +2086,7 @@ merge db filename (Message ps) = merge_ db filename qs | |||
2091 | _ | isKey p && is_subkey p -> (top,p,ret p) | 2086 | _ | isKey p && is_subkey p -> (top,p,ret p) |
2092 | _ | isUserID p -> (top,p,ret p) | 2087 | _ | isUserID p -> (top,p,ret p) |
2093 | _ | isTrust p -> (top,sub,updateTrust top sub prev p) | 2088 | _ | isTrust p -> (top,sub,updateTrust top sub prev p) |
2094 | _ | otherwise -> (top,sub,ret p) | 2089 | _ -> (top,sub,ret p) |
2095 | 2090 | ||
2096 | updateTrust top (PublicKeyPacket {}) (pre,t) p = (pre,Map.insert filename p t) -- public | 2091 | updateTrust top (PublicKeyPacket {}) (pre,t) p = (pre,Map.insert filename p t) -- public |
2097 | updateTrust (PublicKeyPacket {}) _ (pre,t) p = (pre,Map.insert filename p t) -- public | 2092 | updateTrust (PublicKeyPacket {}) _ (pre,t) p = (pre,Map.insert filename p t) -- public |
@@ -2226,7 +2221,7 @@ merge_ db filename qs = foldl mergeit db (zip [0..] qs) | |||
2226 | 2221 | ||
2227 | unsig :: FilePath -> Bool -> SigAndTrust -> [MappedPacket] | 2222 | unsig :: FilePath -> Bool -> SigAndTrust -> [MappedPacket] |
2228 | unsig fname isPublic (sig,trustmap) = | 2223 | unsig fname isPublic (sig,trustmap) = |
2229 | [sig]++ map (asMapped (-1)) ( take 1 . Map.elems $ Map.filterWithKey f trustmap) | 2224 | sig : map (asMapped (-1)) ( take 1 . Map.elems $ Map.filterWithKey f trustmap) |
2230 | where | 2225 | where |
2231 | f n _ = n==fname -- && trace ("fname=n="++show n) True | 2226 | f n _ = n==fname -- && trace ("fname=n="++show n) True |
2232 | asMapped n p = let m = mappedPacket fname p | 2227 | asMapped n p = let m = mappedPacket fname p |
@@ -2290,7 +2285,7 @@ getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames)) | |||
2290 | _ -> mzero | 2285 | _ -> mzero |
2291 | 2286 | ||
2292 | addr = fingerdress topk | 2287 | addr = fingerdress topk |
2293 | -- name = maybe "" id $ listToMaybe onames -- TODO: more than one tor key? | 2288 | -- name = fromMaybe "" $ listToMaybe onames -- TODO: more than one tor key? |
2294 | topk = packet topmp | 2289 | topk = packet topmp |
2295 | torkeys = do | 2290 | torkeys = do |
2296 | SubKey k sigs <- Map.elems subs | 2291 | SubKey k sigs <- Map.elems subs |
@@ -2311,7 +2306,7 @@ getHostnames (KeyData topmp _ uids subs) = (addr,(onames,othernames)) | |||
2311 | guard . not . null $ signatures_over v' | 2306 | guard . not . null $ signatures_over v' |
2312 | return torsig | 2307 | return torsig |
2313 | guard (not $ null sigs') | 2308 | guard (not $ null sigs') |
2314 | return $ subk | 2309 | return subk |
2315 | has_tag tag p = isSignaturePacket p | 2310 | has_tag tag p = isSignaturePacket p |
2316 | && or [ tag `elem` mapMaybe usage (hashed_subpackets p) | 2311 | && or [ tag `elem` mapMaybe usage (hashed_subpackets p) |
2317 | , tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) ] | 2312 | , tag `elem` map usageString (mapMaybe keyflags (hashed_subpackets p)) ] |
@@ -2386,14 +2381,14 @@ setHostnames pred hosts kd@(KeyData topmp topsigs uids subs) = | |||
2386 | psig = packet sig | 2381 | psig = packet sig |
2387 | p' = if isSignaturePacket psig then psig { unhashed_subpackets = ps } | 2382 | p' = if isSignaturePacket psig then psig { unhashed_subpackets = ps } |
2388 | else psig | 2383 | else psig |
2389 | uh = unhashed_subpackets $ psig | 2384 | uh = unhashed_subpackets psig |
2390 | (ns,ps) = partition isName uh | 2385 | (ns,ps) = partition isName uh |
2391 | 2386 | ||
2392 | fingerdress :: Packet -> SockAddr | 2387 | fingerdress :: Packet -> SockAddr |
2393 | fingerdress topk = maybe zero id $ Hosts.inet_pton addr_str | 2388 | fingerdress topk = fromMaybe zero $ Hosts.inet_pton addr_str |
2394 | where | 2389 | where |
2395 | zero = SockAddrInet 0 0 | 2390 | zero = SockAddrInet 0 0 |
2396 | addr_str = colons $ "fd" ++ (drop 10 $ map toLower $ fingerprint topk) | 2391 | addr_str = colons $ "fd" ++ drop 10 (map toLower $ fingerprint topk) |
2397 | colons (a:b:c:d:xs@(_:_)) = [a,b,c,d,':'] ++ colons xs | 2392 | colons (a:b:c:d:xs@(_:_)) = [a,b,c,d,':'] ++ colons xs |
2398 | colons xs = xs | 2393 | colons xs = xs |
2399 | 2394 | ||
@@ -2403,5 +2398,5 @@ backsig _ = Nothing | |||
2403 | 2398 | ||
2404 | socketFamily :: SockAddr -> Family | 2399 | socketFamily :: SockAddr -> Family |
2405 | socketFamily (SockAddrInet _ _) = AF_INET | 2400 | socketFamily (SockAddrInet _ _) = AF_INET |
2406 | socketFamily (SockAddrInet6 _ _ _ _) = AF_INET6 | 2401 | socketFamily (SockAddrInet6 {}) = AF_INET6 |
2407 | socketFamily (SockAddrUnix _) = AF_UNIX | 2402 | socketFamily (SockAddrUnix _) = AF_UNIX |