module Network.IPFS.Peer
( all
, rawList
, connect
, connectRetry
, disconnect
, getExternalAddress
) where
import qualified RIO.List as List
import qualified RIO.Text as Text
import qualified Network.IP.Addr as Addr
import Text.Regex
import qualified Network.IPFS.Internal.UTF8 as UTF8
import Network.IPFS.Prelude hiding (all)
import Network.IPFS.Info.Types
import Network.IPFS.Local.Class as IPFS
import Network.IPFS.Peer.Error as IPFS.Peer
import Network.IPFS.Peer.Types
import qualified Network.IPFS.Process.Error as Process
import qualified Network.IPFS.Types as IPFS
all :: MonadLocalIPFS m => m (Either IPFS.Peer.Error [IPFS.Peer])
all :: m (Either Error [Peer])
all = m (Either Error RawMessage)
forall (m :: * -> *).
MonadLocalIPFS m =>
m (Either Error RawMessage)
rawList m (Either Error RawMessage)
-> (Either Error RawMessage -> Either Error [Peer])
-> m (Either Error [Peer])
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
Right RawMessage
raw -> case RawMessage -> Either UnicodeException Text
forall a. Textable a => a -> Either UnicodeException Text
UTF8.encode RawMessage
raw of
Left UnicodeException
_ -> Error -> Either Error [Peer]
forall a b. a -> Either a b
Left (Error -> Either Error [Peer])
-> (String -> Error) -> String -> Either Error [Peer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Error
DecodeFailure (String -> Either Error [Peer]) -> String -> Either Error [Peer]
forall a b. (a -> b) -> a -> b
$ RawMessage -> String
forall a. Show a => a -> String
show RawMessage
raw
Right Text
text -> [Peer] -> Either Error [Peer]
forall a b. b -> Either a b
Right ([Peer] -> Either Error [Peer]) -> [Peer] -> Either Error [Peer]
forall a b. (a -> b) -> a -> b
$ Text -> Peer
IPFS.Peer (Text -> Peer) -> [Text] -> [Peer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> [Text]
Text.lines Text
text
Left Error
err -> Error -> Either Error [Peer]
forall a b. a -> Either a b
Left (Error -> Either Error [Peer])
-> (Text -> Error) -> Text -> Either Error [Peer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
UnknownErr (Text -> Either Error [Peer]) -> Text -> Either Error [Peer]
forall a b. (a -> b) -> a -> b
$ Error -> Text
forall a. Show a => a -> Text
UTF8.textShow Error
err
rawList :: MonadLocalIPFS m => m (Either Process.Error Process.RawMessage)
rawList :: m (Either Error RawMessage)
rawList = [String] -> RawMessage -> m (Either Error RawMessage)
forall (m :: * -> *).
MonadLocalIPFS m =>
[String] -> RawMessage -> m (Either Error RawMessage)
IPFS.runLocal [Item [String]
"bootstrap", Item [String]
"list"] RawMessage
""
connect :: MonadLocalIPFS m => Peer -> m (Either IPFS.Peer.Error ())
connect :: Peer -> m (Either Error ())
connect peer :: Peer
peer@(Peer Text
peerID) = [String] -> RawMessage -> m (Either Error RawMessage)
forall (m :: * -> *).
MonadLocalIPFS m =>
[String] -> RawMessage -> m (Either Error RawMessage)
IPFS.runLocal [Item [String]
"swarm", Item [String]
"connect"] (Text -> RawMessage
UTF8.textToLazyBS Text
peerID) m (Either Error RawMessage)
-> (Either Error RawMessage -> m (Either Error ()))
-> m (Either Error ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error () -> m (Either Error ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error () -> m (Either Error ()))
-> (Either Error RawMessage -> Either Error ())
-> Either Error RawMessage
-> m (Either Error ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Left Error
_ -> Error -> Either Error ()
forall a b. a -> Either a b
Left (Error -> Either Error ()) -> Error -> Either Error ()
forall a b. (a -> b) -> a -> b
$ Peer -> Error
CannotConnect Peer
peer
Right RawMessage
_ -> () -> Either Error ()
forall a b. b -> Either a b
Right ()
disconnect :: MonadLocalIPFS m => Peer -> m (Either IPFS.Peer.Error ())
disconnect :: Peer -> m (Either Error ())
disconnect peer :: Peer
peer@(Peer Text
peerID) =
[String] -> RawMessage -> m (Either Error RawMessage)
forall (m :: * -> *).
MonadLocalIPFS m =>
[String] -> RawMessage -> m (Either Error RawMessage)
IPFS.runLocal [Item [String]
"swarm", Item [String]
"disconnect"] (Text -> RawMessage
UTF8.textToLazyBS Text
peerID) m (Either Error RawMessage)
-> (Either Error RawMessage -> m (Either Error ()))
-> m (Either Error ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Either Error () -> m (Either Error ())
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Error () -> m (Either Error ()))
-> (Either Error RawMessage -> Either Error ())
-> Either Error RawMessage
-> m (Either Error ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
Left Error
_ -> Error -> Either Error ()
forall a b. a -> Either a b
Left (Error -> Either Error ()) -> Error -> Either Error ()
forall a b. (a -> b) -> a -> b
$ Peer -> Error
CannotDisconnect Peer
peer
Right RawMessage
_ -> () -> Either Error ()
forall a b. b -> Either a b
Right ()
connectRetry :: MonadLocalIPFS m => Peer -> Natural -> m (Either IPFS.Peer.Error ())
connectRetry :: Peer -> Natural -> m (Either Error ())
connectRetry Peer
peer Natural
0 = Either Error () -> m (Either Error ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error () -> m (Either Error ()))
-> (Error -> Either Error ()) -> Error -> m (Either Error ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error ()
forall a b. a -> Either a b
Left (Error -> m (Either Error ())) -> Error -> m (Either Error ())
forall a b. (a -> b) -> a -> b
$ Peer -> Error
CannotConnect Peer
peer
connectRetry Peer
peer Natural
tries = Peer -> m (Either Error ())
forall (m :: * -> *).
MonadLocalIPFS m =>
Peer -> m (Either Error ())
connect Peer
peer m (Either Error ())
-> (Either Error () -> m (Either Error ())) -> m (Either Error ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Right ()
_ -> Either Error () -> m (Either Error ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error () -> m (Either Error ()))
-> Either Error () -> m (Either Error ())
forall a b. (a -> b) -> a -> b
$ () -> Either Error ()
forall a b. b -> Either a b
Right ()
Left Error
_err -> Peer -> Natural -> m (Either Error ())
forall (m :: * -> *).
MonadLocalIPFS m =>
Peer -> Natural -> m (Either Error ())
connectRetry Peer
peer (Natural
tries Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
- Natural
1)
peerAddressRe :: Regex
peerAddressRe :: Regex
peerAddressRe = String -> Regex
mkRegex String
"^/ip[46]/([a-zA-Z0-9.:]*)/"
extractIPfromPeerAddress :: String -> Maybe String
String
peer = Regex -> String -> Maybe [String]
matchRegex Regex
peerAddressRe String
peer Maybe [String] -> ([String] -> Maybe String) -> Maybe String
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> Maybe String
forall a. [a] -> Maybe a
List.headMaybe
isExternalIPv4 :: Text -> Bool
isExternalIPv4 :: Text -> Bool
isExternalIPv4 Text
ip = Bool -> (Bool -> Bool) -> Maybe Bool -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Bool -> Bool
not Maybe Bool
isReserved
where
isReserved :: Maybe Bool
isReserved :: Maybe Bool
isReserved = do
String
ipAddress <- String -> Maybe String
extractIPfromPeerAddress (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Text -> String
Text.unpack Text
ip
IP4
normalized <- String -> Maybe IP4
forall a. Read a => String -> Maybe a
readMaybe String
ipAddress
return (IP4 -> Range4
Addr.ip4Range IP4
normalized Range4 -> Range4 -> Bool
forall a. Eq a => a -> a -> Bool
== Range4
Addr.ReservedIP4)
filterExternalPeers :: [Peer] -> [Peer]
filterExternalPeers :: [Peer] -> [Peer]
filterExternalPeers = (Peer -> Bool) -> [Peer] -> [Peer]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Bool
isExternalIPv4 (Text -> Bool) -> (Peer -> Text) -> Peer -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Peer -> Text
peer)
getExternalAddress :: MonadLocalIPFS m => m (Either IPFS.Peer.Error [Peer])
getExternalAddress :: m (Either Error [Peer])
getExternalAddress =
[String] -> RawMessage -> m (Either Error RawMessage)
forall (m :: * -> *).
MonadLocalIPFS m =>
[String] -> RawMessage -> m (Either Error RawMessage)
IPFS.runLocal [Item [String]
"id"] RawMessage
"" m (Either Error RawMessage)
-> (Either Error RawMessage -> m (Either Error [Peer]))
-> m (Either Error [Peer])
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Left Error
err ->
Either Error [Peer] -> m (Either Error [Peer])
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Error [Peer] -> m (Either Error [Peer]))
-> (Text -> Either Error [Peer]) -> Text -> m (Either Error [Peer])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Error -> Either Error [Peer]
forall a b. a -> Either a b
Left (Error -> Either Error [Peer])
-> (Text -> Error) -> Text -> Either Error [Peer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Error
UnknownErr (Text -> m (Either Error [Peer]))
-> Text -> m (Either Error [Peer])
forall a b. (a -> b) -> a -> b
$ Error -> Text
forall a. Show a => a -> Text
UTF8.textShow Error
err
Right RawMessage
raw ->
RawMessage
raw
RawMessage -> (RawMessage -> Maybe Info) -> Maybe Info
forall a b. a -> (a -> b) -> b
|> RawMessage -> Maybe Info
forall a. FromJSON a => RawMessage -> Maybe a
decode
Maybe Info -> (Maybe Info -> [Peer]) -> [Peer]
forall a b. a -> (a -> b) -> b
|> [Peer] -> (Info -> [Peer]) -> Maybe Info -> [Peer]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Info -> [Peer]
addresses
[Peer] -> ([Peer] -> Either Error [Peer]) -> Either Error [Peer]
forall a b. a -> (a -> b) -> b
|> [Peer] -> Either Error [Peer]
forall a b. b -> Either a b
Right ([Peer] -> Either Error [Peer])
-> ([Peer] -> [Peer]) -> [Peer] -> Either Error [Peer]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Peer] -> [Peer]
filterExternalPeers
Either Error [Peer]
-> (Either Error [Peer] -> m (Either Error [Peer]))
-> m (Either Error [Peer])
forall a b. a -> (a -> b) -> b
|> Either Error [Peer] -> m (Either Error [Peer])
forall (f :: * -> *) a. Applicative f => a -> f a
pure