module Network.IPFS.Peer
  ( all
  , rawList
  , connect
  , connectRetry
  , getExternalAddress
  ) where

import qualified RIO.Text            as Text
import qualified RIO.List            as List

import qualified Net.IPv4 as IPv4
import           Text.Regex

import           Network.IPFS.Prelude hiding (all)
import qualified Network.IPFS.Internal.UTF8       as UTF8

import qualified Network.IPFS.Types         as IPFS
import qualified Network.IPFS.Process.Error as Process
import           Network.IPFS.Local.Class   as IPFS
import           Network.IPFS.Peer.Error    as IPFS.Peer
import           Network.IPFS.Peer.Types
import           Network.IPFS.Info.Types

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]) -> Error -> Either Error [Peer]
forall a b. (a -> b) -> a -> b
<| String -> Error
DecodeFailure (String -> Error) -> String -> Error
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 ()

connectRetry ::
  MonadLocalIPFS m
  => Peer
  -> Int
  -> m (Either IPFS.Peer.Error ())
connectRetry :: Peer -> Int -> m (Either Error ())
connectRetry Peer
peer (-1) = 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 Int
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 -> Int -> m (Either Error ())
forall (m :: * -> *).
MonadLocalIPFS m =>
Peer -> Int -> m (Either Error ())
connectRetry Peer
peer (Int
tries Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

peerAddressRe :: Regex
peerAddressRe :: Regex
peerAddressRe = String -> Regex
mkRegex String
"^/ip[46]/([a-zA-Z0-9.:]*)/"

-- | Retrieve just the ip address from a peer address
extractIPfromPeerAddress :: String -> Maybe String
extractIPfromPeerAddress :: String -> Maybe String
extractIPfromPeerAddress 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

-- | True if a given peer address is externally accessable
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
      IPv4
normalized <- Text -> Maybe IPv4
IPv4.decode (Text -> Maybe IPv4) -> Text -> Maybe IPv4
forall a b. (a -> b) -> a -> b
<| String -> Text
Text.pack String
ipAddress
      Bool -> Maybe Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Maybe Bool) -> Bool -> Maybe Bool
forall a b. (a -> b) -> a -> b
<| IPv4 -> Bool
IPv4.reserved IPv4
normalized

-- | Filter a list of peers to include only the externally accessable addresses
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)

-- | Get all external ipfs peer addresses
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]))
-> Either Error [Peer] -> m (Either Error [Peer])
forall a b. (a -> b) -> a -> b
<| Error -> Either Error [Peer]
forall a b. a -> Either a b
Left (Error -> Either Error [Peer]) -> Error -> Either Error [Peer]
forall a b. (a -> b) -> a -> b
<| Text -> Error
UnknownErr (Text -> Error) -> Text -> Error
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