{-# Language NoImplicitPrelude #-}
{-# Language OverloadedStrings #-}
{-# Language ViewPatterns #-}
{-# Language FlexibleContexts #-}
module Server.IPFS where

import API.IPFS
import Servant
import ClassyPrelude

import Network.DNS

import Control.Lens (over, _Left)

handler :: Server API
handler = liftIO getHash >>= either (const (throwError err500)) return
  where
    getHash :: IO (Either String VersionHash)
    getHash =
      makeResolvSeed defaultResolvConf >>=
        \rs -> withResolver rs $ \resolver -> do
          eTxt <- over _Left show <$> lookupTXT resolver "rauhala.info"
          -- This is terrible
          return (eTxt >>= maybe (Left "Could not find dnslink") Right . hash)
    hash [x] = case x of
                    (stripPrefix "dnslink" -> Just h) -> Just . VersionHash . decodeUtf8 $ h
                    _ -> Nothing
    hash _ = Nothing