-- Deals with adding private caches to netrc
module Cachix.Client.NetRc
  ( add,
  )
where

import qualified Cachix.Api as Api
import Cachix.Api.Error (escalateAs)
import Cachix.Client.Config (Config, authToken)
import Cachix.Client.Exception (CachixException (NetRcParseError))
import qualified Data.ByteString as BS
import Data.List (nubBy)
import qualified Data.Text as T
import Network.NetRc
import Protolude
import Servant.Auth.Client (getToken)
import System.Directory (createDirectoryIfMissing, doesFileExist)
import System.FilePath (takeDirectory)

-- | Add a list of binary caches to netrc under `filename`.
--   Makes sure there are no duplicate entries (using domain as a key).
--   If file under filename doesn't exist it's created.
add ::
  Config ->
  [Api.BinaryCache] ->
  FilePath ->
  IO ()
add :: Config -> [BinaryCache] -> FilePath -> IO ()
add config :: Config
config binarycaches :: [BinaryCache]
binarycaches filename :: FilePath
filename = do
  Bool
doesExist <- FilePath -> IO Bool
doesFileExist FilePath
filename
  NetRc
netrc <-
    if Bool
doesExist
      then FilePath -> IO ByteString
BS.readFile FilePath
filename IO ByteString -> (ByteString -> IO NetRc) -> IO NetRc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> IO NetRc
parse
      else NetRc -> IO NetRc
forall (m :: * -> *) a. Monad m => a -> m a
return (NetRc -> IO NetRc) -> NetRc -> IO NetRc
forall a b. (a -> b) -> a -> b
$ [NetRcHost] -> [NetRcMacDef] -> NetRc
NetRc [] []
  Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True (FilePath -> FilePath
takeDirectory FilePath
filename)
  FilePath -> ByteString -> IO ()
BS.writeFile FilePath
filename (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ NetRc -> ByteString
netRcToByteString (NetRc -> ByteString) -> NetRc -> ByteString
forall a b. (a -> b) -> a -> b
$ NetRc -> NetRc
uniqueAppend NetRc
netrc
  where
    parse :: ByteString -> IO NetRc
    parse :: ByteString -> IO NetRc
parse contents :: ByteString
contents = (ParseError -> CachixException)
-> Either ParseError NetRc -> IO NetRc
forall exc (m :: * -> *) l a.
(Exception exc, MonadThrow m) =>
(l -> exc) -> Either l a -> m a
escalateAs (Text -> CachixException
NetRcParseError (Text -> CachixException)
-> (ParseError -> Text) -> ParseError -> CachixException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> Text
forall a b. (Show a, StringConv FilePath b) => a -> b
show) (Either ParseError NetRc -> IO NetRc)
-> Either ParseError NetRc -> IO NetRc
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> Either ParseError NetRc
parseNetRc FilePath
filename ByteString
contents
    -- O(n^2) but who cares?
    uniqueAppend :: NetRc -> NetRc
    uniqueAppend :: NetRc -> NetRc
uniqueAppend (NetRc hosts :: [NetRcHost]
hosts macdefs :: [NetRcMacDef]
macdefs) =
      let f :: NetRcHost -> NetRcHost -> Bool
          f :: NetRcHost -> NetRcHost -> Bool
f x :: NetRcHost
x y :: NetRcHost
y = NetRcHost -> ByteString
nrhName NetRcHost
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== NetRcHost -> ByteString
nrhName NetRcHost
y
       in [NetRcHost] -> [NetRcMacDef] -> NetRc
NetRc ((NetRcHost -> NetRcHost -> Bool) -> [NetRcHost] -> [NetRcHost]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy NetRcHost -> NetRcHost -> Bool
f ([NetRcHost]
new [NetRcHost] -> [NetRcHost] -> [NetRcHost]
forall a. [a] -> [a] -> [a]
++ [NetRcHost]
hosts)) [NetRcMacDef]
macdefs
    new :: [NetRcHost]
    new :: [NetRcHost]
new = (BinaryCache -> NetRcHost) -> [BinaryCache] -> [NetRcHost]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map BinaryCache -> NetRcHost
mkHost ([BinaryCache] -> [NetRcHost]) -> [BinaryCache] -> [NetRcHost]
forall a b. (a -> b) -> a -> b
$ (BinaryCache -> Bool) -> [BinaryCache] -> [BinaryCache]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (BinaryCache -> Bool) -> BinaryCache -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BinaryCache -> Bool
Api.isPublic) [BinaryCache]
binarycaches
    mkHost :: Api.BinaryCache -> NetRcHost
    mkHost :: BinaryCache -> NetRcHost
mkHost bc :: BinaryCache
bc =
      $WNetRcHost :: ByteString
-> ByteString
-> ByteString
-> ByteString
-> [NetRcMacDef]
-> NetRcHost
NetRcHost
        { nrhName :: ByteString
nrhName = Text -> ByteString
forall a b. StringConv a b => a -> b
toS (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
stripPrefix "http://" (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text
stripPrefix "https://" (BinaryCache -> Text
Api.uri BinaryCache
bc),
          nrhLogin :: ByteString
nrhLogin = "",
          nrhPassword :: ByteString
nrhPassword = Token -> ByteString
getToken (Config -> Token
authToken Config
config),
          nrhAccount :: ByteString
nrhAccount = "",
          nrhMacros :: [NetRcMacDef]
nrhMacros = []
        }
      where
        -- stripPrefix that either strips or returns the same string
        stripPrefix :: Text -> Text -> Text
        stripPrefix :: Text -> Text -> Text
stripPrefix prefix :: Text
prefix str :: Text
str =
          Text -> (Text -> Text) -> Maybe Text -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
str Text -> Text
forall a. a -> a
identity (Maybe Text -> Text) -> Maybe Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Maybe Text
T.stripPrefix Text
prefix Text
str