-- | Gemini protocol client,
-- see <https://geminiprotocol.net/docs/specification.gmi>
module GeminiFetchF where
import Fudgets
import AllFudgets(readM)
import Http
import StatusCode
import HeaderNames
import URL
import Unicode(decodeUTF8)

-- | Fetch documents from Gemini servers.
-- The URL should be of the form gemini://host/...
-- and the response is converted to a HTTP response
geminiFetchF = g2h >^=< geminiFetchF'
  where
    g2h (url,resp) =
      (,) url $
      case break (=='\n') resp of
        (hdr,body) ->
          case break (==' ') (filter (/='\r') hdr) of
            (status,meta) ->
              case readM status of
                Just st -> response st meta (drop 1 body)
                _ -> Left "Bad status code in response header"

    response st meta body =
      case st of
        20 -> rr normalResult [(contentType,meta)] body
        30 -> rr temporaryRedirect [(location,meta)] ""
        31 -> rr movedPermanently [(location,meta)] ""
        51 -> rr notFound [] ("Not found "++meta)
        _  -> rr (SC (10*st) meta) [] (meta++"\n"++body) -- hmm

    rr sc h b = Right $ HttpResp sc h b

-- | Fetch documents from Gemini servers.
-- The URL should be of the form gemini://host/...
-- and the resonse from the server is returned unprocessed 
geminiFetchF' =
    loopThroughRightF (absF idleSP)
                      ({-tF "out ">==<-} dynF nullF {- >==<idLeftF (tF "in ")-})
  where
--  onlyStdoutF = stripEither >^=< idLeftF stderrFa
--  tF pre = teeF ((++"\n").show) pre

    idleSP = getSP $ either (const idleSP) startSP
    startSP url = maybe idleSP (sendSP url) (urlHost url)

    sendSP url host =
        putSP (Left (Left sslF)) $
        waitSP $
        waitSP $
        putSP (Left (Right (url2str url++"\r\n"))) $
        receiveSP [] $ \ doc ->
        putSP (Right (url,decodeUTF8 doc)) $
        idleSP
      where
        sslF = subProcessF ("openssl s_client -quiet -connect "++host++":1965")

    waitSP cont = getSP $ either fromSSL fromGUI
      where
        fromSSL (Right s) | "verify return:1" `elem` lines s = cont -- hmm
        fromSSL _ = waitSP cont

    receiveSP buf cont = getSP $ either fromSSL fromGUI
      where
        fromSSL (Left "") = stopSSL $ cont (concat (reverse buf))
        fromSSL (Left s)  = receiveSP (s:buf) cont
        fromSSL _ = receiveSP buf cont

    fromGUI url = stopSSL $ startSP url -- hmm
    stopSSL = putSP (Left (Left nullF))

{-
-- Alternative implementation using a experimental verison of fudgets with
-- support for arbitrary monadic IO from inside fudgets
geminiFetch2F = ioF idleK
  where
    idleK = getHigh $ \ url -> maybe idleK (fetchK url) (urlHost url)
    fetchK url host =
      hIO (strIO (readProcess "openssl" ["s_client","-quiet","-connect",host++":1965"] (url++"\r\n"))) $ \ (Str doc) ->
      putHigh (url,doc) $
      idleK
-}


-- -- | Single client cache
--cache1F server = snd >^=< cacheF server >=^< (,) ()