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
|