GeminiProtocol.hs

   1 -- This file is part of Diohsc
   2 -- Copyright (C) 2020 Martin Bays <mbays@sdf.org>
   3 --
   4 -- This program is free software: you can redistribute it and/or modify
   5 -- it under the terms of version 3 of the GNU General Public License as
   6 -- published by the Free Software Foundation, or any later version.
   7 --
   8 -- You should have received a copy of the GNU General Public License
   9 -- along with this program.  If not, see http://www.gnu.org/licenses/.
  10
  11 {-# LANGUAGE OverloadedStrings #-}
  12 {-# LANGUAGE TupleSections     #-}
  13
  14 module GeminiProtocol where
  15
  16 import           Control.Concurrent
  17 import           Control.Exception
  18 import           Control.Monad              (guard, mplus, msum, unless, void,
  19                                              when)
  20 import           Control.Monad.Trans        (lift)
  21 import           Control.Monad.Trans.Maybe  (MaybeT (..), runMaybeT)
  22 import           Data.Default.Class         (def)
  23 import           Data.Hourglass
  24 import           Data.List                  (intercalate, intersperse,
  25                                              isPrefixOf, stripPrefix, transpose)
  26 import           Data.Maybe                 (fromMaybe, isJust)
  27 import           Data.X509
  28 import           Data.X509.CertificateStore
  29 import           Data.X509.Validation       hiding (Fingerprint (..),
  30                                              getFingerprint)
  31 import           Network.Simple.TCP         (closeSock, connectSock,
  32                                              connectSockSOCKS5)
  33 import           Network.Socket             (Socket)
  34 import           Network.TLS                as TLS
  35 import           Network.TLS.Extra.Cipher
  36 import           Network.URI                (isIPv4address, isIPv6address)
  37 import           Safe
  38 import           System.FilePath
  39 import           Time.System
  40
  41 import qualified Data.ByteString            as BS
  42 import qualified Data.ByteString.Lazy       as BL
  43 import qualified Data.ByteString.Lazy.Char8 as BLC
  44
  45 import qualified Codec.MIME.Parse           as MIME
  46 import qualified Codec.MIME.Type            as MIME
  47 import qualified Data.Map                   as M
  48 import qualified Data.Set                   as Set
  49 import qualified Data.Text                  as TS
  50 import qualified Data.Text.Encoding         as TS
  51 import qualified Data.Text.Lazy             as T
  52 import qualified Data.Text.Lazy.Encoding    as T
  53
  54 import           BoundedBSChan
  55 import           ClientCert
  56 import           ClientSessionManager
  57 import           Fingerprint
  58 import           Identity
  59 import           Mundanities
  60 import           Request
  61 import           ServiceCerts
  62
  63 import           URI
  64
  65 import           Data.Digest.DrunkenBishop
  66
  67 defaultGeminiPort :: Int
  68 defaultGeminiPort = 1965
  69
  70 data MimedData = MimedData {mimedMimetype :: MIME.Type, mimedBody :: BL.ByteString}
  71     deriving (Eq,Ord,Show)
  72
  73 showMimeType :: MimedData -> String
  74 showMimeType = TS.unpack . MIME.showMIMEType . MIME.mimeType . mimedMimetype
  75
  76 data ResponseMalformation
  77     = BadHeaderTermination
  78     | BadStatus String
  79     | BadMetaSeparator
  80     | BadMetaLength
  81     | BadUri String
  82     | BadMime String
  83     deriving (Eq,Ord,Show)
  84
  85 data Response
  86     = Input { inputHidden :: Bool, inputPrompt :: String }
  87     | Success { successData :: MimedData }
  88     | Redirect { permanent :: Bool, redirectTo :: URIRef }
  89     | Failure { failureCode :: Int, failureInfo :: String }
  90     | MalformedResponse { responseMalformation :: ResponseMalformation }
  91     deriving (Eq,Ord,Show)
  92
  93 data InteractionCallbacks = InteractionCallbacks
  94     { icbDisplayInfo :: [String] -> IO ()
  95     , icbDisplayWarning :: [String] -> IO ()
  96     , icbWaitKey :: String -> IO Bool -- ^return False on interrupt, else True
  97     , icbPromptYN :: Bool -- ^default answer
  98         -> String -- ^prompt
  99         -> IO Bool
 100     }
 101
 102 data SocksProxy
 103     = NoSocksProxy
 104     | Socks5Proxy String String
 105
 106 -- Note: we're forced to resort to mvars because the tls library (tls-1.5.4 at
 107 -- least) uses IO rather than MonadIO in the onServerCertificate callback.
 108 data RequestContext = RequestContext
 109     InteractionCallbacks
 110     CertificateStore
 111     (MVar (Set.Set Fingerprint))
 112     (MVar (Set.Set Fingerprint))
 113     (MVar (Set.Set String))
 114     FilePath
 115     Bool
 116     SocksProxy
 117     ClientSessions
 118
 119 initRequestContext :: InteractionCallbacks -> FilePath -> Bool -> SocksProxy -> IO RequestContext
 120 initRequestContext callbacks path readOnly socksProxy =
 121     let certPath = path </> "trusted_certs"
 122         serviceCertsPath = path </> "known_hosts"
 123     in do
 124         unless readOnly $ do
 125             mkdirhier certPath
 126             mkdirhier serviceCertsPath
 127         certStore <- fromMaybe (makeCertificateStore []) <$> readCertificateStore certPath
 128         mTrusted <- newMVar Set.empty
 129         mIgnoredCertErrors <- newMVar Set.empty
 130         mIgnoredCCertWarnings <- newMVar Set.empty
 131         RequestContext callbacks certStore mTrusted mIgnoredCertErrors mIgnoredCCertWarnings serviceCertsPath readOnly socksProxy <$> newClientSessions
 132
 133 requestOfProxiesAndUri :: M.Map String Host -> URI -> Maybe Request
 134 requestOfProxiesAndUri proxies uri =
 135     let scheme = uriScheme uri
 136     in if scheme == "file"
 137     then let filePath path
 138                 | ('/':_) <- path = Just path
 139                 | Just path' <- stripPrefix "localhost" path, ('/':_) <- path' = Just path'
 140                 | otherwise = Nothing
 141         in LocalFileRequest . unescapeUriString <$> filePath (uriPath uri)
 142     else do
 143         host <- M.lookup scheme proxies `mplus` do
 144             guard $ scheme == "gemini" || "gemini+" `isPrefixOf` scheme
 145                 -- ^people keep suggesting "gemini+foo" schemes for variations
 146                 -- on gemini. On the basis that this naming convention should
 147                 -- indicate that the scheme is backwards-compatible with
 148                 -- actual gemini, we handle them the same as gemini.
 149             hostname <- decodeIPv6 <$> uriRegName uri
 150             let port = fromMaybe defaultGeminiPort $ uriPort uri
 151             return $ Host hostname port
 152         return . NetworkRequest host $ uri
 153     where
 154     decodeIPv6 :: String -> String
 155     decodeIPv6 ('[':rest) | last rest == ']', addr <- init rest, isIPv6address addr = addr
 156     decodeIPv6 h = h
 157
 158
 159 newtype RequestException = ExcessivelyLongUri Int
 160     deriving Show
 161 instance Exception RequestException
 162
 163 -- |On success, returns `Right lazyResp terminate`. `lazyResp` is a `Response`
 164 -- with lazy IO, so attempts to read it may block while data is received. If
 165 -- the full response is not needed, for example because of an error, the IO
 166 -- action `terminate` should be called to close the connection.
 167 makeRequest :: RequestContext
 168     -> Maybe Identity -- ^client certificate to offer
 169     -> Int -- ^bound in bytes for response stream buffering
 170     -> Bool -- ^whether to display extra information about connection
 171     -> Request -> IO (Either SomeException (Response, IO ()))
 172 makeRequest (RequestContext (InteractionCallbacks displayInfo displayWarning _ promptYN)
 173         certStore mTrusted mIgnoredCertErrors mIgnoredCCertWarnings serviceCertsPath readOnly socksProxy clientSessions) mIdent bound verboseConnection (NetworkRequest (Host hostname port) uri) =
 174     let requestBytes = TS.encodeUtf8 . TS.pack $ show uri ++ "\r\n"
 175         uriLength = BS.length requestBytes - 2
 176         ccfp = clientCertFingerprint . identityCert <$> mIdent
 177     in if uriLength > 1024 then return . Left . toException $ ExcessivelyLongUri uriLength
 178     else handle handleAll $ do
 179         session <- lookupClientSession hostname ccfp clientSessions
 180         let serverId = if port == defaultGeminiPort then BS.empty else TS.encodeUtf8 . TS.pack . (':':) $ show port
 181             sessionManager = clientSessionManager 3600 clientSessions ccfp
 182             params = (TLS.defaultParamsClient hostname serverId)
 183                 { clientSupported = def { supportedCiphers = gemini_ciphersuite }
 184                 -- |RFC6066 disallows SNI with literal IP addresses
 185                 , clientUseServerNameIndication = not $ isIPv4address hostname || isIPv6address hostname
 186                 , clientHooks = def
 187                     { onServerCertificate = checkServerCert
 188                     , onCertificateRequest = \(_,pairs,_) -> case mIdent of
 189                         Nothing -> return Nothing
 190                         Just ident@(Identity idName (ClientCert chain key)) -> do
 191                             let is13 = maybe False ((HashIntrinsic,SignatureEd25519) `elem`) pairs
 192                             allow <- if isTemporary ident || is13 then return True else do
 193                                     ignored <- (idName `Set.member`) <$> readMVar mIgnoredCCertWarnings
 194                                     if ignored then return True else do
 195                                         displayWarning ["Pre-TLS1.3 server: identity "
 196                                             <> idName <> " might be revealed to eavesdroppers!"]
 197                                         conf <- promptYN False "Identify anyway?"
 198                                         when conf $ modifyMVar_ mIgnoredCCertWarnings
 199                                             (return . Set.insert idName)
 200                                         return conf
 201                             return $ if allow then Just (chain,key) else Nothing
 202                     }
 203                 , clientShared = def
 204                     { sharedCAStore = certStore
 205                     , sharedSessionManager = sessionManager }
 206                 , clientEarlyData = Just requestBytes  -- ^Send early data (RTT0) if server session allows it
 207                 , clientWantSessionResume = session
 208                 }
 209         (sock,context) <- do
 210             let retryNoResume e@(HandshakeFailed (Error_Protocol (_,_,HandshakeFailure)))
 211                         | isJust session = do
 212                     -- Work around a mysterious problem seen with dezhemini+libssl:
 213                     displayWarning [ "Handshake failure when resuming TLS session; retrying with full handshake." ]
 214                     sock <- openSocket
 215                     c <- TLS.contextNew sock $ params { clientWantSessionResume = Nothing }
 216                     handshake c >> return (sock,c)
 217                 retryNoResume e = throw e
 218             sock <- openSocket
 219             c <- TLS.contextNew sock params
 220             handle retryNoResume $ handshake c >> return (sock,c)
 221         sentEarly <- (== Just True) . (infoIsEarlyDataAccepted <$>) <$> contextGetInformation context
 222         unless sentEarly . sendData context $ BL.fromStrict requestBytes
 223         when verboseConnection . void . runMaybeT $ do
 224             info <- MaybeT $ contextGetInformation context
 225             lift . displayInfo $ [ "TLS version " ++ show (infoVersion info) ++
 226                 ", cipher " ++ cipherName (infoCipher info) ]
 227             mode <- MaybeT . return $ infoTLS13HandshakeMode info
 228             lift . displayInfo $ [ "Handshake mode " ++ show mode ]
 229         chan <- newBSChan bound
 230         let recvAllLazily = do
 231                 r <- recvData context
 232                 unless (BS.null r) $ writeBSChan chan r >> recvAllLazily
 233         recvThread <- forkFinally recvAllLazily $ \_ ->
 234             -- |XXX: note that writeBSChan can't block when writing BS.empty
 235             writeBSChan chan BS.empty >> bye context >> closeSock sock
 236         lazyResp <- parseResponse . BL.fromChunks . takeWhile (not . BS.null) <$> getBSChanContents chan
 237         return $ Right (lazyResp, killThread recvThread)
 238     where
 239     handleAll :: SomeException -> IO (Either SomeException a)
 240     handleAll = return . Left
 241
 242     openSocket :: IO Socket
 243     openSocket = case socksProxy of
 244         NoSocksProxy -> fst <$> connectSock hostname (show port)
 245         Socks5Proxy socksHostname socksPort -> do
 246             sock <- fst <$> connectSock socksHostname socksPort
 247             _ <- connectSockSOCKS5 sock hostname (show port)
 248             return sock
 249
 250     checkServerCert store cache service chain@(CertificateChain signedCerts) = do
 251         errors <- doTofu =<< validate Data.X509.HashSHA256 defaultHooks
 252             (defaultChecks { checkExhaustive = True , checkLeafV3 = False }) store cache service chain
 253         if null errors || any isTrustError errors || null signedCerts
 254         then return errors
 255         else do
 256             ignored <- (tailFingerprint `Set.member`) <$> readMVar mIgnoredCertErrors
 257             if ignored then return [] else do
 258                 displayWarning [
 259                     "Certificate chain has trusted root, but validation errors: "
 260                     ++ show errors ]
 261                 displayWarning $ showChain signedCerts
 262                 ignore <- promptYN False "Ignore errors?"
 263                 if ignore
 264                 then modifyMVar_ mIgnoredCertErrors (return . Set.insert tailFingerprint) >> return []
 265                 else return errors
 266         where
 267         isTrustError = (`elem` [UnknownCA, SelfSigned, NotAnAuthority])
 268
 269         -- |error pertaining to the tail certificate, to be ignored if the
 270         -- user explicitly trusts the certificate for this service.
 271         isTrustableError LeafNotV3        = True
 272         isTrustableError (NameMismatch _) = True
 273         isTrustableError _                = False
 274
 275         tailSigned = head signedCerts
 276         tailFingerprint = fingerprint tailSigned
 277
 278         chainSigsFail :: Maybe SignatureFailure
 279         chainSigsFail =
 280             let verify (signed:signing:rest) = msum [
 281                     case verifySignedSignature signed . certPubKey $ getCertificate signing of
 282                         SignaturePass           -> Nothing
 283                         SignatureFailed failure -> Just failure
 284                     , verify (signing:rest) ]
 285                 verify _ = Nothing
 286             in verify signedCerts
 287
 288         doTofu errors = if not . any isTrustError $ errors
 289             then return errors
 290             else do
 291                 trust <- checkTrust $ filter isTrustableError errors
 292                 return $ if trust
 293                     then filter (\e -> not $ isTrustError e || isTrustableError e) errors
 294                     else errors
 295
 296         checkTrust :: [FailedReason] -> IO Bool
 297         checkTrust errors = do
 298             trusted <- (tailFingerprint `Set.member`) <$> readMVar mTrusted
 299             if trusted then return True else do
 300                 trust <- checkTrust' errors
 301                 when trust $ modifyMVar_ mTrusted (return . Set.insert tailFingerprint)
 302                 return trust
 303         checkTrust' :: [FailedReason] -> IO Bool
 304         checkTrust' _ | Just sigFail <- chainSigsFail = do
 305             displayWarning [ "Invalid signature in certificate chain: " ++ show sigFail ]
 306             return False
 307         checkTrust' errors = do
 308             let certs = map getCertificate signedCerts
 309                 tailCert = head certs
 310                 serviceString = serviceToString service
 311                 warnErrors = unless (null errors) . displayWarning $
 312                     [ "WARNING: tail certificate has verification errors: " <> show errors ]
 313             known <- loadServiceCert serviceCertsPath service `catch` ((>> return Nothing) . printIOErr)
 314             if known == Just tailSigned then do
 315                 displayInfo [ "Accepting previously trusted certificate " ++ take 8 (fingerprintHex tailFingerprint) ++ "; expires " ++ printExpiry tailCert ++ "." ]
 316                 when verboseConnection . displayInfo $ fingerprintPicture tailFingerprint
 317                 return True
 318             else do
 319                 displayInfo $ showChain signedCerts
 320                 let promptTrust def pprompt tprompt = do
 321                         p <- promptYN def pprompt
 322                         if p then return (True,True) else
 323                             (False,) <$> promptYN def tprompt
 324                 (saveCert,trust) <- case known of
 325                     Nothing -> do
 326                         displayInfo [ "No certificate previously seen for " ++ serviceString ++ "." ]
 327                         warnErrors
 328                         let prompt = "provided certificate (" ++
 329                                 take 8 (fingerprintHex tailFingerprint) ++ ")?"
 330                         promptTrust (null errors) ("Permanently trust " ++ prompt)
 331                             ("Temporarily trust " ++ prompt)
 332                     Just trustedSignedCert -> do
 333                         currentTime <- timeConvert <$> timeCurrent
 334                         let trustedCert = getCertificate trustedSignedCert
 335                             expired = currentTime > (snd . certValidity) trustedCert
 336                             samePubKey = certPubKey trustedCert == certPubKey tailCert
 337                             oldFingerprint = fingerprint trustedSignedCert
 338                             oldInfo = [ "Fingerprint of old certificate: " ++ fingerprintHex oldFingerprint ]
 339                                 ++ fingerprintPicture oldFingerprint
 340                                 ++ [ "Old certificate " ++ (if expired then "expired" else "expires") ++
 341                                     ": " ++ printExpiry trustedCert ]
 342                             signedByOld = SignaturePass `elem`
 343                                 ((`verifySignedSignature` certPubKey trustedCert) <$> signedCerts)
 344                         if signedByOld
 345                             then displayInfo $
 346                                 ("The new certificate chain is signed by " ++
 347                                 (if expired then "an EXPIRED" else "a") ++
 348                                 " key previously trusted for this host.") : oldInfo
 349                             else if expired || samePubKey
 350                             then displayInfo $
 351                                 ("A different " ++ (if expired then "expired " else "non-expired ") ++
 352                                 "certificate " ++ (if samePubKey then "with the same public key " else "") ++
 353                                 "for " ++ serviceString ++ " was previously explicitly trusted.") : oldInfo
 354                             else displayWarning $
 355                                 ("CAUTION: A certificate with a different public key for " ++ serviceString ++
 356                                 " was previously explicitly trusted and has not expired!") : oldInfo
 357                         warnErrors
 358                         promptTrust (signedByOld || expired || samePubKey)
 359                             ("Permanently trust new certificate" <>
 360                                 (if readOnly then ""
 361                                 else " (replacing old certificate (which will be backed up))") <> "?")
 362                             ("Temporarily trust new certificate" <>
 363                                 (if readOnly then ""
 364                                 else " (but keep old certificate)") <> "?")
 365                 when (saveCert && not readOnly) $
 366                     saveServiceCert serviceCertsPath service tailSigned `catch` printIOErr
 367                 return trust
 368
 369         printExpiry :: Certificate -> String
 370         printExpiry = timePrint ISO8601_Date . snd . certValidity
 371
 372         showChain :: [SignedCertificate] -> [String]
 373         showChain [] = [""]
 374         showChain signed = let
 375             sigChain = reverse signed
 376             certs = map getCertificate sigChain
 377             showCN = maybe "[Unspecified CN]" (TS.unpack . TS.decodeUtf8 . getCharacterStringRawData) . getDnElement DnCommonName
 378             issuerCN = showCN . certIssuerDN $ head certs
 379             subjectCNs = map (showCN . certSubjectDN) certs
 380             hexes = map (fingerprintHex . fingerprint) sigChain
 381             pics = map (fingerprintPicture . fingerprint) sigChain
 382             expStrs = map (("Expires " ++) . printExpiry) certs
 383             picsWithInfo = map (map $ centre 23) $ zipWith (++) pics $ transpose [subjectCNs, expStrs]
 384             centre n s = take n $ replicate ((n - length s) `div` 2) ' ' ++ s ++ repeat ' '
 385             tweenCol = replicate 6 "     " ++ [" >>> "] ++ replicate 6 "     "
 386             sideBySide = map concat . transpose
 387             in [ "Certificate chain: " ++ intercalate " >>> " (issuerCN:subjectCNs) ]
 388                 ++ (sideBySide . intersperse tweenCol $ picsWithInfo)
 389                 ++ zipWith (++) ("": repeat ">>> ") hexes
 390
 391     printIOErr :: IOError -> IO ()
 392     printIOErr = displayWarning . (:[]) . show
 393
 394     fingerprintHex :: Fingerprint -> String
 395     fingerprintHex (Fingerprint fp) = concat $ hexWord8 <$> BS.unpack fp
 396         where hexWord8 w =
 397                 let (a,b) = quotRem w 16
 398                     hex = ("0123456789abcdef" !!) . fromIntegral
 399                 in hex a : hex b : ""
 400     fingerprintPicture :: Fingerprint -> [String]
 401     fingerprintPicture (Fingerprint fp) = boxedDrunkenBishop fp where
 402         boxedDrunkenBishop :: BS.ByteString -> [String]
 403         boxedDrunkenBishop s = ["+-----[X509]------+"]
 404             ++ (map (('|':) . (++"|")) . lines $ drunkenBishopPreHashed s)
 405             ++ ["+----[SHA256]-----+"]
 406         drunkenBishopPreHashed :: BS.ByteString -> String
 407         drunkenBishopPreHashed = drunkenBishopWithOptions $
 408             drunkenBishopDefaultOptions { drunkenBishopHash = id }
 409
 410     -- |those ciphers from ciphersuite_default fitting the requirements
 411     -- recommended by the gemini "best practices" document:
 412     -- require ECDHE/DHE (for PFS), and >=SHA2, and AES/CHACHA20.
 413     gemini_ciphersuite :: [Cipher]
 414     gemini_ciphersuite =
 415         [        -- First the PFS + GCM + SHA2 ciphers
 416           cipher_ECDHE_ECDSA_AES128GCM_SHA256, cipher_ECDHE_ECDSA_AES256GCM_SHA384
 417         , cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256
 418         , cipher_ECDHE_RSA_AES128GCM_SHA256, cipher_ECDHE_RSA_AES256GCM_SHA384
 419         , cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256
 420         , cipher_DHE_RSA_AES128GCM_SHA256, cipher_DHE_RSA_AES256GCM_SHA384
 421         , cipher_DHE_RSA_CHACHA20POLY1305_SHA256
 422         ,        -- Next the PFS + CCM + SHA2 ciphers
 423           cipher_ECDHE_ECDSA_AES128CCM_SHA256, cipher_ECDHE_ECDSA_AES256CCM_SHA256
 424         , cipher_DHE_RSA_AES128CCM_SHA256, cipher_DHE_RSA_AES256CCM_SHA256
 425                  -- Next the PFS + CBC + SHA2 ciphers
 426         , cipher_ECDHE_ECDSA_AES128CBC_SHA256, cipher_ECDHE_ECDSA_AES256CBC_SHA384
 427         , cipher_ECDHE_RSA_AES128CBC_SHA256, cipher_ECDHE_RSA_AES256CBC_SHA384
 428         , cipher_DHE_RSA_AES128_SHA256, cipher_DHE_RSA_AES256_SHA256
 429                 -- TLS13 (listed at the end but version is negotiated first)
 430         , cipher_TLS13_AES128GCM_SHA256
 431         , cipher_TLS13_AES256GCM_SHA384
 432         , cipher_TLS13_CHACHA20POLY1305_SHA256
 433         , cipher_TLS13_AES128CCM_SHA256
 434         ]
 435
 436     parseResponse :: BL.ByteString -> Response
 437     parseResponse resp =
 438         let (header, rest) = BLC.break (== '\r') resp
 439             body = BL.drop 2 rest
 440             statusString = T.unpack . T.decodeUtf8 . BL.take 2 $ header
 441             separator = BL.take 1 . BL.drop 2 $ header
 442             meta = T.unpack . T.decodeUtf8 . BL.drop 3 $ header
 443         in
 444         if BL.take 2 rest /= "\r\n" then MalformedResponse BadHeaderTermination
 445         else if separator `notElem` [""," ","\t"] -- ^allow \t for now, though it's against latest spec
 446         then MalformedResponse BadMetaSeparator
 447         else if BL.length header > 1024+3 then MalformedResponse BadMetaLength
 448         else case readMay statusString of
 449             Just status | status >= 10 && status < 80 ->
 450                 let (status1,status2) = divMod status 10
 451                 in case status1 of
 452                     1 -> Input (status2 == 1) meta
 453                     2 -> maybe (MalformedResponse (BadMime meta))
 454                         (\mime -> Success $ MimedData mime body) $
 455                         MIME.parseMIMEType (TS.pack $
 456                             if null meta then "text/gemini; charset=utf-8" else meta)
 457                     3 -> maybe (MalformedResponse (BadUri meta))
 458                         (Redirect (status2 == 1)) $ parseUriReference meta
 459                     _ -> Failure status meta
 460             _ -> MalformedResponse (BadStatus statusString)
 461
 462 makeRequest _ _ _ _ (LocalFileRequest _) = error "File requests not handled by makeRequest"