29 lines
874 B
Haskell
29 lines
874 B
Haskell
{-# 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
|