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