Factor out HTTP requests

src/Nix/Builtins.hs

@@ -1038,7 +1038,9 @@ fetchurl v = v >>= \case
  where
     go :: Maybe (NThunk m) -> NValue m -> m (NValue m)
     go _msha = \case
-        NVStr ns -> getURL (hackyStringIgnoreContext ns) -- msha
+        NVStr ns -> getURL (hackyStringIgnoreContext ns) >>= \case -- msha
+            Left e -> throwError e
+            Right p -> toValue p
         v -> throwError $ ErrorCall $
                  "builtins.fetchurl: Expected URI or string, got " ++ show v
 

src/Nix/Convert.hs

@@ -391,6 +391,12 @@ instance Applicative m => ToValue Path m (NValueNF m) where
 instance Applicative m => ToValue Path m (NValue m) where
     toValue = pure . nvPath . getPath
 
+instance Applicative m => ToValue StorePath m (NValueNF m) where
+    toValue = toValue . Path . unStorePath
+
+instance Applicative m => ToValue StorePath m (NValue m) where
+    toValue = toValue . Path . unStorePath
+
 instance MonadThunk (NValue m) (NThunk m) m
       => ToValue SourcePos m (NValue m) where
     toValue (SourcePos f l c) = do

src/Nix/Effects.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DefaultSignatures #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeFamilies #-}
 module Nix.Effects where
 
@@ -8,17 +9,22 @@ import qualified Prelude
 
 import           Control.Monad.Trans
 import           Data.Text (Text)
+import qualified Data.Text as T
+import           Network.HTTP.Client hiding (path)
+import           Network.HTTP.Client.TLS
+import           Network.HTTP.Types
 import           Nix.Frames
 import           Nix.Render
 import           Nix.Value
+import           Nix.Utils
+import           System.Directory
 import           System.Exit
 import           System.Process
-import           System.Directory
 
 -- | A path into the nix store
 newtype StorePath = StorePath { unStorePath :: FilePath }
 
-class (MonadFile m, MonadStore m, MonadPutStr m) => MonadEffects m where
+class (MonadFile m, MonadStore m, MonadPutStr m, MonadHttp m) => MonadEffects m where
     -- | Determine the absolute path of relative path in the current context
     makeAbsolutePath :: FilePath -> m FilePath
     findEnvPath :: String -> m FilePath
@@ -39,14 +45,38 @@ class (MonadFile m, MonadStore m, MonadPutStr m) => MonadEffects m where
 
     nixInstantiateExpr :: String -> m (NValue m)
 
-    getURL :: Text -> m (NValue m)
-
     getRecursiveSize :: a -> m (NValue m)
 
     traceEffect :: String -> m ()
 
     exec :: [String] -> m (NValue m)
 
+class Monad m => MonadHttp m where
+    getURL :: Text -> m (Either ErrorCall StorePath)
+    default getURL :: (MonadTrans t, MonadHttp m', m ~ t m') => Text -> m (Either ErrorCall StorePath)
+    getURL = lift . getURL
+
+instance MonadHttp IO where
+    getURL url = do
+        let urlstr = T.unpack url
+        traceM $ "fetching HTTP URL: " ++ urlstr
+        req <- parseRequest urlstr
+        manager <-
+          if secure req
+          then newTlsManager
+          else newManager defaultManagerSettings
+        -- print req
+        response <- httpLbs (req { method = "GET" }) manager
+        let status = statusCode (responseStatus response)
+        if  status /= 200
+          then return $ Left $ ErrorCall $
+                 "fail, got " ++ show status ++ " when fetching url:" ++ urlstr
+          else -- do
+            -- let bstr = responseBody response
+            return $ Left $ ErrorCall $
+              "success in downloading but hnix-store is not yet ready; url = " ++ urlstr
+
+
 class Monad m => MonadPutStr m where
     --TODO: Should this be used *only* when the Nix to be evaluated invokes a
     --`trace` operation?

src/Nix/Exec.hs

@@ -51,9 +51,6 @@ import           Data.Text (Text)
 import qualified Data.Text as Text
 import           Data.Typeable
 import           GHC.IO.Exception (IOErrorType(..))
-import           Network.HTTP.Client
-import           Network.HTTP.Client.TLS
-import           Network.HTTP.Types
 import           Nix.Atoms
 import           Nix.Context
 import           Nix.Convert
@@ -508,8 +505,10 @@ instance MonadStore m => MonadStore (Lazy m) where
 
 instance MonadPutStr m => MonadPutStr (Lazy m)
 
+instance MonadHttp m => MonadHttp (Lazy m)
+
 instance (MonadFix m, MonadCatch m, MonadFile m, MonadStore m, MonadVar m,
-          MonadPutStr m, MonadIO m, Alternative m, MonadPlus m, Typeable m)
+          MonadPutStr m, MonadHttp m, MonadIO m, Alternative m, MonadPlus m, Typeable m)
       => MonadEffects (Lazy m) where
     makeAbsolutePath origPath = do
         origPathExpanded <- expandHomePath origPath
@@ -614,27 +613,6 @@ instance (MonadFix m, MonadCatch m, MonadFile m, MonadStore m, MonadVar m,
         const $ toNix (0 :: Integer)
 #endif
 
-    getURL url = do
-        let urlstr = Text.unpack url
-        traceM $ "fetching HTTP URL: " ++ urlstr
-        response <- liftIO $ do
-          req <- parseRequest urlstr
-          manager <-
-            if secure req
-            then newTlsManager
-            else newManager defaultManagerSettings
-          -- print req
-          httpLbs (req { method = "GET" }) manager
-          -- return response
-        let status = statusCode (responseStatus response)
-        if  status /= 200
-          then throwError $ ErrorCall $
-                 "fail, got " ++ show status ++ " when fetching url:" ++ urlstr
-          else -- do
-            -- let bstr = responseBody response
-            throwError $ ErrorCall $
-              "success in downloading but hnix-store is not yet ready; url = " ++ urlstr
-
     traceEffect = putStrLn
 
     exec = \case